×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

merge pdf files

merge pdf files

merge pdf files

(OP)
I have this code that I got from "igor krupitsky which he posted on another site. It merges (appends) 2 pdf files. I need to edit the code so that it does this:

I have 8,000 files in a folder and I want to merge the files that have the same prefix name in the filename. i.e.

122TX4939.pdf
122TX4939 Support.pdf
122TX4939 Additional.pdf

333RS111.pdf
333RS111 Support.pdf

555DA77.pdf


Results:

The first 3 would get merged into 1 file:
122TX4939.pdf

The next 2 would get merged into 1 file:
333RS111.pdf

The last file would get copied or merged byitself
555DA77.pdf

and they would be in a destination folder other than the folder with the 8,000 pdf files.


Code:
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = fso.GetParentFolderName(WScript.ScriptFullName)
Set oFolder = fso.GetFolder(sFolder)
Set oArgs = WScript.Arguments

If oArgs.Count = 0 Then
'Double Click
MergeFiles
Else
'Drag & Drop
For I = 0 to oArgs.Count - 1
If LCase(Right(oArgs(I), 4)) = ".pdf" Then
MergeTwoFiles oArgs(I)
End If
Next
End If

'=======================================================
Sub MergeFiles()

bFirstDoc = True

If oFolder.Files.Count < 2 Then
MsgBox "You need to have at least two PDF files in the same folder to merge."
'fso.CopyFile(oFolder.Files.Name, oFolder & "\Results")
Exit Sub
End If


For Each oFile In oFolder.Files
If LCase(Right(oFile.Name, 4)) = ".pdf" Then

If bFirstDoc Then
bFirstDoc = False
Set oMainDoc = CreateObject("AcroExch.PDDoc")
oMainDoc.Open sFolder & "\" & oFile.Name
Else
Set oTempDoc = CreateObject("AcroExch.PDDoc")
oTempDoc.Open sFolder & "\" & oFile.Name
oMainDoc.InsertPages oMainDoc.GetNumPages - 1, oTempDoc, 0, oTempDoc.GetNumPages, False
oTempDoc.Close
End If

End If
Next

oMainDoc.Save 1, sFolder & "\Output.pdf"
oMainDoc.Close
MsgBox "Done! See Output.pdf file."

End Sub
'=======================================================
Sub MergeTwoFiles(sFileName)

If Not fso.FileExists(sFolder & "\Output.pdf") Then
fso.CopyFile sFileName, sFolder & "\Output.pdf"
Exit Sub
End If

Set oMainDoc = CreateObject("AcroExch.PDDoc")
oMainDoc.Open sFolder & "\Output.pdf"

Set oTempDoc = CreateObject("AcroExch.PDDoc")
oTempDoc.Open sFileName

oMainDoc.InsertPages oMainDoc.GetNumPages - 1, oTempDoc, 0, oTempDoc.GetNumPages, False
oMainDoc.Save 1, sFolder & "\Output.pdf"
oTempDoc.Close
oMainDoc.Close
MsgBox "Done! See Output.pdf file."
End Sub

RE: merge pdf files

It is generally clear what you are wanting to do but you haven't asked a specific question. This is not a "write a program for me" forum. It's a "I've tried to get it to work but I've had no luck, please help!" type of forum.

Given the information you've provided, I would approach the task like this:

1. Find the PDF files that need merging.
2. Group them by prefix.
3. Merge each group of files.

Attempt to complete these steps. If you run into trouble, there are plenty of documents, FAQs, and people that will help you get passed it - but not before you try yourself.

-Geates

NOTE: Step 3 assumes that you have the appropriate DLL registered. Igor is using the DLL that provides the AcroExch.PDDoc object.

http://ns7.webmasters.com/caspdoc/html/vbscript_la...

RE: merge pdf files

(OP)
Ok, so I started writing the code and I am now running into an error msg and I can't figure out why?
"Invalid procedure call or argument: 'InStr'"
Line:27


Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "E:\PRGX\Data\test\files\"
dFolder = "E:\PRGX\Data\test\files\Output"
Set oFolder = fso.GetFolder(sFolder)
Dim file_group

'Sort the list in the Array name.
'listArray = SortedFiles(oFolder)
'listArray = SortedFiles(sFolder)
file_names = SortedFiles(sFolder)

'msgbox "file_names : " & file_names(1)

'listArray = Quicksort(file_names, 1, oFolder.Files.Count)
listArray = Quick_sort(file_names, 1, oFolder.Files.Count)

'msgbox "testa " & listArray(0) & " testb " & listArray(1)

f_filename = ""
l_filename = ""
'file_group(0) = ""
'msgbox uBound(listArray)
For x = 0 To uBound(listArray)
f_filename = listArray(x)
i = x + 1
msgbox "listArray " & listArray(i)
Do While InStr(listArray(i), f_filename, VBTextCompare) > 0
ReDim Preserve file_group(i)
file_group(i) = listArray(i)
i = i + 1
MsgBox "Step1"
Loop
x = i
MergePDFFiles(file_group)

ReDim file_group(0)

Next
MsgBox "Done"

Function MergePDFFiles(ByRef pdf_files)
bFirstDoc = True
recs = UBound(pdf_files)
If recs < 2 Then
'If oFolder.Files.Count < 2 Then
' MsgBox "needed 2 pdf."
Set oMainDoc = CreateObject("AcroExch.PDDoc")
oMainDoc.Open sFolder & "\" & f_filename & ".pdf" 'oFile.Name
oMainDoc.Save 1, dFolder & f_filename & ".pdf"
oMainDoc.Close
Exit Function
End If
'For Each oFile In oFolder.Files
For i = 0 To UBound(pdf_files)
MsgBox "MergePDFFiles"
If bFirstDoc Then
bFirstDoc = False
Set oMainDoc = CreateObject("AcroExch.PDDoc")
oMainDoc.Open sFolder & "\" & f_filename & ".pdf" 'oFile.Name
Else
Set oTempDoc = CreateObject("AcroExch.PDDoc")
oTempDoc.Open sFolder & "\" & pdf_files(i) & ".pdf"
oMainDoc.InsertPages oMainDoc.GetNumPages - 1, oTempDoc, 0, oTempDoc.GetNumPages, False
oTempDoc.Close
End If
Next

oMainDoc.Save 1, dFolder & f_filename & ".pdf"
oMainDoc.Close
oTempDoc.Close
'MsgBox "ok"

End Function

' Return an array containing the names of the
' files in the directory sorted alphabetically.
Function SortedFiles(dir_path)
Dim file_names
Set fso = CreateObject("Scripting.FileSystemObject")

' Get the FSO Folder (directory) object.
Set fso_folder = fso.GetFolder(dir_path)

' Make the list of names.
ReDim file_names(fso_folder.Files.Count)
'msgbox "filecount " & fso_folder.Files.Count
i = 0
For Each fso_file In fso_folder.Files
'MsgBox "SortFiles"
file_names(i) = Mid(fso_file.Name,1,Len(fso_file.Name)-4) 'File name minus the extension.
i = i + 1
ntemp = file_names(i)
'MsgBox i & " " & ntemp
Next 'fso_file

' Sort the list of files.
'Quick_sort file_names, 1, fso_folder.Files.Count

' Return the sorted list.
SortedFiles = file_names

End Function

Function Quick_Sort(ByRef SortArray, ByRef First, ByRef Last)
'Dim Low As Long, High As Long
'Dim Temp As Variant, List_Separator As Variant
Dim List_Separator
Low = First
High = Last
'msgbox "QuickSorta " & SortArray(0) & "QuickSortb " & SortArray(1)
List_Separator = SortArray((First + Last) / 2)
Do
Do While (SortArray(Low) < List_Separator)
Low = Low + 1
Loop
Do While (SortArray(High) > List_Separator)
High = High - 1
Loop
If (Low <= High) Then
Temp = SortArray(Low)
SortArray(Low) = SortArray(High)
SortArray(High) = Temp
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last

'msgbox "ArrayCount: " & UBound(SortArray)
'For i = 0 To UBound(SortArray)
' msgbox "fortest: " & SortArray(i)
'Next

'Return the sorted list
Quick_Sort = SortArray

End Function

RE: merge pdf files

(OP)
I think the issue is in the Array. I put a msgbox to check the values in the arry.Both (i+1) and (i-1) give me results (a file name). But (i) is blank.

For x = 0 To uBound(listArray)
f_filename = listArray(x)
i = x + 1
msgbox "listArrayi " & listArray(i) & "- listArrayi +1: " & listArray(i+1) & "- listArrayi -1: " & listArray(i-1)
Do While InStr(listArray(i), f_filename, VBTextCompare) > 0
ReDim Preserve file_group(i)
file_group(i) = listArray(i)
i = i + 1
MsgBox "Step1"
Loop
x = i
MergePDFFiles(file_group)

ReDim file_group(0)

Next

RE: merge pdf files

(OP)
I think the issue is in the Array. I put a msgbox's to check the values in the array. After my quick_sort function is where there is a gap in my list. (0) has a value but (1) does not have a value..it is blank... (2), (3)-(7) all have values. Why is it leaving a space ? and how can i ignore it or remove it from my array?

file_names = SortedFiles(sFolder)

msgbox file_names(0) & chr(13) & file_names(1) & chr(13) & file_names(2) & chr(13) & file_names(3) & chr(13) & file_names(4) & chr(13) & file_names(5) & chr(13) & file_names(6) & chr(13) & file_names(7) & chr(13)& file_names(8)

listArray = Quick_sort(file_names, 1, oFolder.Files.Count)

msgbox oFolder.Files.Count
msgbox listArray(0) & chr(13) & listArray(1) & chr(13) & listArray(2) & chr(13) & listArray(3) & chr(13) & listArray(4) & chr(13) & listArray(5) & chr(13) & listArray(6) & chr(13) & listArray(7) & chr(13)& listArray(8)

f_filename = ""
l_filename = ""
'file_group(0) = ""
'msgbox uBound(listArray)
For x = 0 To uBound(listArray)
f_filename = listArray(x)
i = x + 1
msgbox "listArrayi: " & listArray(i) & "- listArrayi +1: " & listArray(i+1) & "- listArrayi -1: " & listArray(i-1)
Do While InStr(listArray(i), f_filename, VBTextCompare) > 0
ReDim Preserve file_group(i)
file_group(i) = listArray(i)
i = i + 1
MsgBox "Step1"
Loop
x = i
MergePDFFiles(file_group)

ReDim file_group(0)

Next

RE: merge pdf files

(OP)
This worked:
listArray = Quick_sort(file_names, 1, oFolder.Files.Count - 1)

The array was adding an element...i fixed that.
Now i get a new error msg here below. It says "Type mismatch: 'listArray(...)'

I'm pretty sure it is in Do While line that it is happening:

For x = 0 To uBound(listArray)
f_filename = listArray(x)
i = x + 1
msgbox "ubound: " & UBound(listArray)
msgbox "listArrayi: " & listArray(i) & "- listArrayi +1: " & listArray(i+1) & "- listArrayi -1: " & listArray(i-1)
Do While InStr(listArray(i), f_filename, 1) > 0
ReDim Preserve file_group(i)
file_group(i) = listArray(i)
i = i + 1
MsgBox "Step1"
Loop
x = i
MergePDFFiles(file_group)

ReDim file_group(0)

Next

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close