VBA, Combine PDFs into one PDF

[jrwrita]

Hi all,

Say I have a few pdfs, I list location/file name in cell, 1 pdf file with 5 pages, and a few other pdfs, is there any vba code that can combine this into one pdf? Is this possible?

 

[John_w]

This can be done with the Acrobat API, which is only available with Acrobat Pro, not the free Adobe Reader. Example code at https://www.mrexcel.com/forum/excel...through-files-folder-match-part-filename.html

 

[jrwrita]

Is there anyway to do this in vba?

 

[John_w]

The code in the link I provided is Excel VBA calling the Acrobat API.

 

[jrwrita]

Hi john, i've tried it, do you have any documentation on setting this up? this is what I have so far:

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

 

[John_w]

Is Acrobat Pro installed on your computer? If so, try this code, which merges the PDFs in column A of the active sheet starting at A2. In the VBA editor you must set a reference to Adobe Acrobat n.0 Type Library, via Tools -> References.

'References
'Adobe Acrobat 10.0 Type Library

Option Explicit

Public Sub Merge_PDFs()

    Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
    Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
    Dim PDFfiles As Range, PDFfile As Range
    Dim n As Long
    
    With ActiveSheet
        Set PDFfiles = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
    End With
    
    'Create Acrobat API objects
    
    Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
    Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
    
    'Open first PDF file and merge other PDF files into it
    
    n = 0
    For Each PDFfile In PDFfiles
        n = n + 1
        If n = 1 Then
            objCAcroPDDocDestination.Open PDFfile.Value
        Else
            objCAcroPDDocSource.Open PDFfile.Value
            If Not objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
                MsgBox "Error merging " & PDFfile.Value
            End If
            objCAcroPDDocSource.Close
        End If
    Next
    
    'Save merged PDF files as a new file
    
    objCAcroPDDocDestination.Save 1, ThisWorkbook.Path & "\Merged PDFs.pdf"
    objCAcroPDDocDestination.Close
    
    Set objCAcroPDDocSource = Nothing
    Set objCAcroPDDocDestination = Nothing

    MsgBox "Created " & ThisWorkbook.Path & "\Merged PDFs.pdf"
    
End Sub

 

[bunburyst]

Thanks for this, awesome macro.

I have a problem, sometimes at the beginning of the range, A2, it may be empty and the macro doesn't work. It works correctly if A2 has any patch, how can I fix this?

 

[John_w]

I have a problem, sometimes at the beginning of the range, A2, it may be empty and the macro doesn't work. It works correctly if A2 has any patch, how can I fix this?

Replace the Set PDFfiles line with:

        Set PDFfiles = .Columns("A").Find(What:="*", After:=.Range("A1"), LookIn:=xlValues)
        Set PDFfiles = .Range(PDFfiles, .Cells(.Rows.Count, "A").End(xlUp))

 

[bunburyst]

Replace the Set PDFfiles line with:

        Set PDFfiles = .Columns("A").Find(What:="*", After:=.Range("A1"), LookIn:=xlValues)
        Set PDFfiles = .Range(PDFfiles, .Cells(.Rows.Count, "A").End(xlUp))

Thanks so much John, it works perfectly, cool!