merge pdf files

[abenitez77]

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

 

[Geates]

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_language_reference.htm

 

[abenitez77]

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

 

[PHV]

Use this instead:
Do While InStr(1, listArray(i), f_filename, 1) > 0

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[abenitez77]

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

 

[abenitez77]

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

 

[PHV]

I'd try this:
listArray = Quick_sort(file_names, 0, oFolder.Files.Count - 1)

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[abenitez77]

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