VBA, Combine PDFs into one PDF file
This is my understanding of your question:
Requirements:
• Combined a series of pdf files, located in the same folder of the workbook containing the procedure
• Pdf files names go from firstpdf1.pdf to firstpdfn.pdf where n is the total number of files to be combined
Let’s review your original code:
• All variables should be declared:
Dim objCAcroPDDocSource as object, objCAcroPDDocDestination as object
• This line is missing the path separator "\":
PDFfileName = Dir(ThisWorkbook.Path & "firstpdf" & n & ".pdf")
It should be PDFfileName = Dir(ThisWorkbook.Path & "\" & "firstpdf" & n & ".pdf")
• Therefore this line always returns "" (no pdf file was found in the ThisWorkbook.Path):
If PDFfileName <> "" Then
Additionally:
• These lines would have returned: Error - 424 Object required as the objects objCAcroPDDocSource and objCAcroPDDocDestination were not initialized:
objCAcroPDDocSource.Open ThisWorkbook.Path & "pathwithpdfs" & PDFfileName
If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
objCAcroPDDocSource.Close
• The objCAcroPDDocDestination was never opened.
Solutions: These procedures use the Adobe Acrobat Library
Adobe Acrobat Library - Early bound
To create the Vb Reference to the Adobe Library in the VBA Editor menu click Tools`Referencesthen select theAdobe Acrobat Libraryin the dialog window then press theOK` button.
Sub PDFs_Combine_EarlyBound()
Dim PdfDst As AcroPDDoc, PdfSrc As AcroPDDoc
Dim sPdfComb As String, sPdf As String
Dim b As Byte
Rem Set Combined Pdf filename - save the combined pdf in a new file in order to preserve original pdfs
sPdfComb = ThisWorkbook.Path & "\" & "Pdf Combined" & Format(Now, " mmdd_hhmm ") & ".pdf" 'change as required
Rem Open Destination Pdf
b = 1
sPdf = ThisWorkbook.Path & "\" & "firstpdf" & b & ".pdf"
Set PdfDst = New AcroPDDoc
If Not (PdfDst.Open(sPdf)) Then
MsgBox "Error opening destination pdf:" & vbCrLf _
& vbCrLf & "[" & sPdf & "]" & vbCrLf _
& vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
Exit Sub
End If
Do
Rem Set & Validate Source Pdf
b = b + 1
sPdf = ThisWorkbook.Path & "\" & "firstpdf" & b & ".pdf"
If Dir(sPdf, vbArchive) = vbNullString Then Exit Do
Rem Open Source Pdf
Set PdfSrc = New AcroPDDoc
If Not (PdfSrc.Open(sPdf)) Then
MsgBox "Error opening source pdf:" & vbCrLf _
& vbCrLf & "[" & sPdf & "]" & vbCrLf _
& vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
GoTo Exit_Sub
End If
With PdfDst
Rem Insert Source Pdf pages
If Not (.InsertPages(-1 + .GetNumPages, PdfSrc, 0, PdfSrc.GetNumPages, 0)) Then
MsgBox "Error inserting source pdf:" & vbCrLf _
& vbCrLf & "[" & sPdf & "]" & vbCrLf _
& vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
GoTo Exit_Sub
End If
Rem Save Combined Pdf
If Not (.Save(PDSaveFull, sPdfComb)) Then
MsgBox "Error saving combined pdf:" & vbCrLf _
& vbCrLf & "[" & sPdfComb & "]" & vbCrLf _
& vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
GoTo Exit_Sub
End If
PdfSrc.Close
Set PdfSrc = Nothing
End With
' sPdf = Dir(sPdf, vbArchive)
' Loop While sPdf <> vbNullString
Loop
MsgBox "Pdf files combined successfully!", vbExclamation
Exit_Sub:
PdfDst.Close
End Sub
Adobe Acrobat Library - Late bound
No need to create the Vb Reference to the Adobe Library
Sub PDFs_Combine_LateBound()
Dim PdfDst As Object, PdfSrc As Object
Dim sPdfComb As String, sPdf As String
Dim b As Byte
Rem Set Combined Pdf filename - save the combined pdf in a new file in order to preserve original pdfs
sPdfComb = ThisWorkbook.Path & "\" & "Pdf Combined" & Format(Now, " mmdd_hhmm ") & ".pdf" 'change as required
Rem Open Destination Pdf
b = 1
sPdf = ThisWorkbook.Path & "\" & "firstpdf" & b & ".pdf"
Set PdfDst = CreateObject("AcroExch.PDDoc")
If Not (PdfDst.Open(sPdf)) Then
MsgBox "Error opening destination pdf:" & vbCrLf _
& vbCrLf & "[" & sPdf & "]" & vbCrLf _
& vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
Exit Sub
End If
Do
Rem Set & Validate Source filename
b = b + 1
sPdf = ThisWorkbook.Path & "\" & "firstpdf" & b & ".pdf"
If Dir(sPdf, vbArchive) = vbNullString Then Exit Do
Rem Open Source filename
Set PdfSrc = CreateObject("AcroExch.PDDoc")
If Not (PdfSrc.Open(sPdf)) Then
MsgBox "Error opening source pdf:" & vbCrLf _
& vbCrLf & "[" & sPdf & "]" & vbCrLf _
& vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
GoTo Exit_Sub
End If
With PdfDst
Rem Insert Source filename pages
If Not (.InsertPages(-1 + .GetNumPages, PdfSrc, 0, PdfSrc.GetNumPages, 0)) Then
MsgBox "Error inserting source pdf:" & vbCrLf _
& vbCrLf & "[" & sPdf & "]" & vbCrLf _
& vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
GoTo Exit_Sub
End If
Rem Save Combined Pdf
If Not (.Save(1, sPdfComb)) Then
MsgBox "Error saving combined pdf:" & vbCrLf _
& vbCrLf & "[" & sPdfComb & "]" & vbCrLf _
& vbCrLf & vbTab & "Procees will be cancelled!", vbCritical
GoTo Exit_Sub
End If
PdfSrc.Close
Set PdfSrc = Nothing
End With
' sPdf = Dir(sPdf, vbArchive)
' Loop While sPdf <> vbNullString
Loop
MsgBox "Pdf files combined successfully!", vbExclamation
Exit_Sub:
PdfDst.Close
End Sub
You need to have adobe acrobat installed / operational.
I used this resource re method references
https://wwwimages2.adobe.com/content/dam/acom/en/devnet/acrobat/pdfs/iac_api_reference.pdf
EDIT: Swapping the array for auto generated (mostly, the primary pdf still set by user) list of pathways to pdfs that you want to insert into the primary pdf)
You can use something like below to generate the collection of documents to be inserted into your primary doc. The first file in the collection would be the file that you are inserting into, same as in first example. Then assign the folder pathway of the folder with the pdf files that you would like to see inserted into your primary doc to inputDirectoryToScanForFile. The loop in this code will add the pathway of every pdf file in that folder to your collection. These are the pathways later used in the adobe API calls to insert pdf into your primary.
Sub main()
Dim myCol As Collection
Dim strFile As String
Dim inputDirectoryToScanForFile As String
Dim primaryFile As String
Set myCol = New Collection
primaryFile = "C:\Users\Evan\Desktop\myPDf.Pdf"
myCol.Add primaryFile
inputDirectoryToScanForFile = "C:\Users\Evan\Desktop\New Folder\"
strFile = Dir(inputDirectoryToScanForFile & "*.pdf")
Do While strFile <> ""
myCol.Add strFile
strFile = Dir
Loop
End Sub
Code that takes a primary file and inserts other pdfs into that file:
Sub main()
Dim arrayFilePaths() As Variant
Set app = CreateObject("Acroexch.app")
arrayFilePaths = Array("C:\Users\Evan\Desktop\PAGE1.pdf", _
"C:\Users\Evan\Desktop\PAGE2.pdf", _
"C:\Users\Evan\Desktop\PAGE3.pdf")
Set primaryDoc = CreateObject("AcroExch.PDDoc")
OK = primaryDoc.Open(arrayFilePaths(0))
Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK
For arrayIndex = 1 To UBound(arrayFilePaths)
numPages = primaryDoc.GetNumPages() - 1
Set sourceDoc = CreateObject("AcroExch.PDDoc")
OK = sourceDoc.Open(arrayFilePaths(arrayIndex))
Debug.Print "SOURCE DOC OPENED & PDDOC SET: " & OK
numberOfPagesToInsert = sourceDoc.GetNumPages
OK = primaryDoc.InsertPages(numPages, sourceDoc, 0, numberOfPagesToInsert, False)
Debug.Print "PAGES INSERTED SUCCESSFULLY: " & OK
OK = primaryDoc.Save(PDSaveFull, arrayFilePaths(0))
Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK
Set sourceDoc = Nothing
Next arrayIndex
Set primaryDoc = Nothing
app.Exit
Set app = Nothing
MsgBox "DONE"
End Sub