Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBA, Combine PDFs into one PDF file

Tags:

excel

vba

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
like image 572
excelguy Avatar asked Jul 17 '18 20:07

excelguy


1 Answers

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
like image 164
learnAsWeGo Avatar answered Sep 30 '22 12:09

learnAsWeGo