Merge Multiple PDF into one thru VBA (1 Viewer)

VBANEWBIE

Registered User.
Local time
Today, 04:19
Joined
Oct 17, 2016
Messages
17
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

so...

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
Staff member
Local time
Today, 09:19
Joined
Feb 19, 2013
Messages
16,604
what code are you using now? will be easier to correct it to loop through recordsets etc
 

VBANEWBIE

Registered User.
Local time
Today, 04:19
Joined
Oct 17, 2016
Messages
17
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")

pdfsrc = "C:\Users\jfontes\Documents\RPTTESTEXPORT\Part1.pdf"


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")

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\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"

End Sub
 

Minty

AWF VIP
Local time
Today, 09:19
Joined
Jul 26, 2013
Messages
10,366
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
Staff member
Local time
Today, 09:19
Joined
Feb 19, 2013
Messages
16,604
perhaps something like

Code:
 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
 

VBANEWBIE

Registered User.
Local time
Today, 04:19
Joined
Oct 17, 2016
Messages
17
Hi Minty,
I cant produce only one report because of the size(I believe),
what I'm trying to do is create a seven page pdf in which every page has different data from the same qry,
I know that a mail merge would be the simplest way, but this is what I was asked to?!?!


Hi CJ, thanks for the code,

I couldn't get it to work but I was able to take some lines from yours and now it is cycling thru the recordset but, it fails to actually merge and at the end it fails to save the document to the "merged" folder... but the messages are popping up at each record so it is cycling which I wasn't able to make happen before...

here is my new code, any thoughts?

as always, thanks in advance...

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 rst As dao.Recordset
Const path As String = "C:\Users\jfontes\Documents\RPTTESTEXPORT\"

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")

Set rst = CurrentDb.OpenRecordset("SELECT GlobalID, RptName, FROM QryDetail", dbOpenSnapshot)
While Not rst.EOF

Part1Document.Open (path & RptName & "- 1.PDF")
Part2Document.Open (path & RptName & "- RptS2P1.PDF")
Part3Document.Open (path & RptName & "- RptS2P2.PDF")
Part4Document.Open (path & RptName & "- RptS2P3.PDF")
Part5Document.Open (path & RptName & "- RptS3P1.PDF")
Part6Document.Open (path & RptName & "- RptS3P2.PDF")
Part7Document.Open (path & RptName & "- RptS3P3.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\" & RptName & ".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
rst.MoveNext
Wend

rst.Close
Set rst = Nothing
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
 

CJ_London

Super Moderator
Staff member
Local time
Today, 09:19
Joined
Feb 19, 2013
Messages
16,604
thoughts - would be easier to read if you indented the code.

you don't seem to be using rptname from your rst recordset - note you haven't declared it either which implies you have not set option explicit at the top of the module which would make debugging much easier

don't know why you are using this

If Part1Document.InsertPages(5, Part6Document, 0, Part6Document.GetNumPages(), True) = False Then
End If

when you can just use

Part1Document.InsertPages 5, Part6Document, 0, Part6Document.GetNumPages(), True
 

VBANEWBIE

Registered User.
Local time
Today, 04:19
Joined
Oct 17, 2016
Messages
17
Thanks CJ,

I've made a few changes as I believe you suggested...

1)
I changed this part.
Part1Document.InsertPages 1, Part2Document, 0, Part2Document.GetNumPages(), True
Part1Document.InsertPages 2, Part3Document, 0, Part3Document.GetNumPages(), True

2)
I changed
Part1Document.Open (path & RptName & "- 1.PDF")
to
Part1Document.Open (path & rs!RptName & "- 1.PDF")

now, a few questions
where and how would I declare the "RptName" from my record set?

and how would I indent the code to make it easier to read...

I'm really new to this so I am extremely grateful with all the insight

thanks again
 

CJ_London

Super Moderator
Staff member
Local time
Today, 09:19
Joined
Feb 19, 2013
Messages
16,604
not sure this will work

Part1Document.Open (path & rs!RptName & "- 1.PDF")


since your recordset is called rst
where and how would I declare the "RptName" from my record set?
you have in the sql to open the recordset
and how would I indent the code to make it easier to read...
assuming you have it indented in your vba window, when you paste it into the post, highlight it and click the code button (the # button in the advanced editor).

If you are not indenting in vba, just use the tab key which will add 4 spaces

Code:
 if x=1 then
     y=3
 end if

99% of example code has indenting
 

VBANEWBIE

Registered User.
Local time
Today, 04:19
Joined
Oct 17, 2016
Messages
17
Got it...

thanks CJ, everything is working

really appreciate you help

now onto the next task...
 

Users who are viewing this thread

Top Bottom