I am trying to combine PDF's into one single pdf with the use of vba. I would like to not use a plug in tool and have tried with acrobat api below.
I have tried something like, but cannot seem to get it to work. I get no error msg but perhaps I am missing parts.
Any help would be appreciated.
Sub Combine()
Dim n As Long, PDFfileName As String
n = 1
Do
n = n + 1
PDFfileName = Dir(ThisWorkbook.Path & "firstpdf" & n & ".pdf")
If PDFfileName <> "" Then
'Open the source document that will be added to the destination
objCAcroPDDocSource.Open ThisWorkbook.Path & "pathwithpdfs" & PDFfileName
If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
MsgBox "Merged " & PDFfileName
Else
MsgBox "Error merging " & PDFfileName
End If
objCAcroPDDocSource.Close
End If
Loop While PDFfileName <> ""
End Sub
new code:
New Code:
Sub main()
Dim arrayFilePaths() As Variant
Set app = CreateObject("Acroexch.app")
arrayFilePaths = Array("mypath.pdf", _
"mypath2.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
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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With