VBA, Combine PDFs into one PDF

jrwrita

Board Regular
Joined
May 7, 2015
Messages
206
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?
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Hi john, i've tried it, do you have any documentation on setting this up? this is what I have so far:

Code:
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
 
Upvote 0
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.

Code:
'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
 
Upvote 0
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?
 
Upvote 0
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:
VBA Code:
        Set PDFfiles = .Columns("A").Find(What:="*", After:=.Range("A1"), LookIn:=xlValues)
        Set PDFfiles = .Range(PDFfiles, .Cells(.Rows.Count, "A").End(xlUp))
 
Upvote 0
Replace the Set PDFfiles line with:
VBA Code:
        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!
 
Upvote 0

Forum statistics

Threads
1,223,247
Messages
6,171,004
Members
452,374
Latest member
keccles

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top