Merge Multiple PDF into one thru VBA (1 Viewer)

I have a current VBA script that loops thru every recordset and export 7 reports into 7 pdfs with a unique file name derived from the "CustomerID" field in the recordset.

so 1000 records means I have a folder with 7000 pdfs all with unique filenames.

now I need to merge every 7 into 1 final pdf

example 1:
Cust1-pg1.pdf
Cust1-pg2.pdf
Cust1-pg3.pdf
Cust1-pg4.pdf
Cust1-pg5.pdf
Cust1-pg6.pdf
Cust1-pg7.pdf

needs to merge in to one pdf called. Cust1.pdf

example 2
Cust99-pg1.pdf
Cust99-pg2.pdf
Cust99-pg3.pdf
Cust99-pg4.pdf
Cust99-pg5.pdf
Cust99-pg6.pdf
Cust99-pg7.pdf

needs to merge in to one pdf called. Cust99.pdf

I have been successful at creating a script the merges properly except the file locations are hardcoded into the script and it does not loop thru the recordset.

when I try to make the file location a variable and then loop thru the recordset, all kinds of error occur.

anyone have any ideas, suggestions or scripts they can share?

I'm fairly new to this VBA world so any insights would be greatly appreciated.

thank you in advance

CJ_London

Super Moderator

VBANEWBIE

Registered User.

Here is the code that I got to work, but need to loop and somehow have a variable for the filelocations.

Private Sub MergePDF_Click()
Dim AcroApp

Dim Part1Document
Dim Part2Document
Dim Part3Document
Dim Part4Document
Dim Part5Document
Dim Part6Document
Dim Part7Document

Dim numPages As Integer
Dim pdfsrc As String
Dim X As Integer
Dim stMergeName As String
Dim strundate As String
Dim rs As DAO.Recordset

Set AcroApp = CreateObject("AcroExch.App")

Set Part1Document = CreateObject("AcroExch.PDDoc")
Set Part2Document = CreateObject("AcroExch.PDDoc")
Set Part3Document = CreateObject("AcroExch.PDDoc")
Set Part4Document = CreateObject("AcroExch.PDDoc")
Set Part5Document = CreateObject("AcroExch.PDDoc")
Set Part6Document = CreateObject("AcroExch.PDDoc")
Set Part7Document = CreateObject("AcroExch.PDDoc")

Part1Document.Open ("C:\Users\jfontes\Documents\RPTTESTEXPORT\Part1.pdf")
Part2Document.Open ("C:\Users\jfontes\Documents\RPTTESTEXPORT\Part2.pdf")
Part3Document.Open ("C:\Users\jfontes\Documents\RPTTESTEXPORT\Part3.pdf")
Part4Document.Open ("C:\Users\jfontes\Documents\RPTTESTEXPORT\Part4.pdf")
Part5Document.Open ("C:\Users\jfontes\Documents\RPTTESTEXPORT\Part5.pdf")
Part6Document.Open ("C:\Users\jfontes\Documents\RPTTESTEXPORT\Part6.pdf")
Part7Document.Open ("C:\Users\jfontes\Documents\RPTTESTEXPORT\Part7.pdf")

If Part1Document.InsertPages(1, Part2Document, 0, Part2Document.GetNumPages(), True) = False Then
End If
If Part1Document.InsertPages(2, Part3Document, 0, Part3Document.GetNumPages(), True) = False Then
End If
If Part1Document.InsertPages(3, Part4Document, 0, Part4Document.GetNumPages(), True) = False Then
End If
If Part1Document.InsertPages(4, Part5Document, 0, Part5Document.GetNumPages(), True) = False Then
End If
If Part1Document.InsertPages(5, Part6Document, 0, Part6Document.GetNumPages(), True) = False Then
End If
If Part1Document.InsertPages(6, Part7Document, 0, Part7Document.GetNumPages(), True) = False Then
MsgBox "Cannot insert pages"
End If

If Part1Document.Save(PDSaveFull, "C:\Users\jfontes\Documents\RPTTESTEXPORT\MERGED\MergeTest.pdf") = False Then
MsgBox "Cannot save the modified document"
End If

Part1Document.Close
Part2Document.Close
Part3Document.Close
Part4Document.Close
Part5Document.Close
Part6Document.Close
Part7Document.Close

AcroApp.Exit
Set AcroApp = Nothing
Set Part1Document = Nothing
Set Part2Document = Nothing
Set Part3Document = Nothing
Set Part4Document = Nothing
Set Part5Document = Nothing
Set Part6Document = Nothing
Set Part7Document = Nothing

MsgBox "Merge is Done"

Minty

AWF VIP

Could you not create the 7 reports as one report, by using each of the current reports as a sub report in one "master" report. Then you won't need to merge them.

CJ_London

Super Moderator

perhaps something like

 private sub mergeall dim rst as dao.recordset const path as string="C:\Users\jfontes\Documents\RPTTESTEXPORT\Cust" set rst=currentdb.openrecordset("SELECT CustID FROM tblCustomers",dbopensnapshot) while not rst.eof 'check if cust file exists and merge if it does if dir(path & rst!custid & "-pg1.pdf")<>"" then mergePDF rst!custiD rst.movenext wend rst.close set rst=nothing end sub private Sub MergePDF(CustID as long) Dim AcroApp Dim Part1Document Dim Part2Document Dim Part3Document Dim Part4Document Dim Part5Document Dim Part6Document Dim Part7Document Dim numPages As Integer 'Dim pdfsrc As String 'Dim X As Integer 'Dim stMergeName As String 'Dim strundate As String 'Dim rs As DAO.Recordset const path as string="C:\Users\jfontes\Documents\RPTTESTEXPORT\Cust" Set AcroApp = CreateObject("AcroExch.App") Set Part1Document = CreateObject("AcroExch.PDDoc") Set Part2Document = CreateObject("AcroExch.PDDoc") Set Part3Document = CreateObject("AcroExch.PDDoc") Set Part4Document = CreateObject("AcroExch.PDDoc") Set Part5Document = CreateObject("AcroExch.PDDoc") Set Part6Document = CreateObject("AcroExch.PDDoc") Set Part7Document = CreateObject("AcroExch.PDDoc") 'pdfsrc = path & custid & "-pg1.pdf" Part1Document.Open(path & custid & "-pg1.pdf") Part2Document.Open(path & custid & "-pg2.pdf") Part3Document.Open(path & custid & "-pg3.pdf") Part4Document.Open(path & custid & "-pg4.pdf") Part5Document.Open(path & custid & "-pg5.pdf") Part6Document.Open(path & custid & "-pg6.pdf") Part7Document.Open(path & custid & "-pg7.pdf") numPages = 2 If Part1Document.InsertPages(1, Part2Document, 0, Part2Document.GetNumPages(), True) = False Then End If If Part1Document.InsertPages(2, Part3Document, 0, Part3Document.GetNumPages(), True) = False Then End If If Part1Document.InsertPages(3, Part4Document, 0, Part4Document.GetNumPages(), True) = False Then End If If Part1Document.InsertPages(4, Part5Document, 0, Part5Document.GetNumPages(), True) = False Then End If If Part1Document.InsertPages(5, Part6Document, 0, Part6Document.GetNumPages(), True) = False Then End If If Part1Document.InsertPages(6, Part7Document, 0, Part7Document.GetNumPages(), True) = False Then MsgBox "Cannot insert pages" End If If Part1Document.Save(PDSaveFull, "C:\Users\jfontes\Documents\RPTTESTEXPORT\MERGED\Cust" & custid & ".pdf") = False Then MsgBox "Cannot save the modified document" End If Part1Document.Close Part2Document.Close Part3Document.Close Part4Document.Close Part5Document.Close Part6Document.Close Part7Document.Close AcroApp.Exit Set AcroApp = Nothing Set Part1Document = Nothing Set Part2Document = Nothing Set Part3Document = Nothing Set Part4Document = Nothing Set Part5Document = Nothing Set Part6Document = Nothing Set Part7Document = Nothing MsgBox "Merge is Done" End Sub Private Sub MergePDF_Click() mergeall End sub