Merge PDFs with VBA

Marl3y

New Member
Joined
Oct 18, 2021
Messages
3
Office Version
  1. 2010
Platform
  1. Windows
Hi! I was trying to look for a way to merge PDFs with a macro. I saw this (VBA, Combine PDFs into one PDF) and tried to modify but cannot do it.


File 1File 2File 3File 4Merge Name
Document1.pdfDocument12.pdfMerge1.pdf
Document21.pdfDocument22.pdfDocument23.pdfMerge2.pdf
Document31.pdDocument32.pdfMerge3.pdf
Document41.pdfDocument42.pdfDocument43.pdfDocument44.pdfMerge4.pdf


VBA 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 & Range("E2").Value
    objCAcroPDDocDestination.Close
    
    Set objCAcroPDDocSource = Nothing
    Set objCAcroPDDocDestination = Nothing

    MsgBox "Created " & ThisWorkbook.Path & Range("E2").Value
    
End Sub

I want to merge all the pdfs in row 2 together, then rename with the name in E2. The complication is that not every row has the same amount of files to merge and not every month we have the same number of rows.

I tried to run this code. I get an error "Error merging Document21.pdf" as well as "Created C:\Users\Marlowe\Documents\MergeMerge1.pdf" - but no file was created.

Is what I want possible to achieve? :(

Thanks in advance.
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Marl3y

New Member
Joined
Oct 18, 2021
Messages
3
Office Version
  1. 2010
Platform
  1. Windows
Hi there. Just hoping someone might have any more ideas. I tried to change the data to mirror this other forum question I found (Merge PDF documents and save with a new name as per Excel Sheet)

File 1File 2File 3File 4Merge Name
C:\Users\Marlowe\Documents\Merge\Doc1.pdfC:\Users\Marlowe\Documents\Merge\Doc2.pdfC:\Users\Marlowe\Documents\Merge\Merge1.pdf

VBA Code:
'Reference: Adobe Acrobat nn.0 Type Library

Public Sub Merge_PDFs()
    Dim PDFfiles As Variant
    Dim i As Long
    Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
    Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
        
    With ActiveSheet
        PDFfiles = .Range("A2", .Cells(.Rows.Count, "C").End(xlUp)).Value
    End With
    
    'Create Acrobat API objects
    
    Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
    Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
    
    'Loop through rows, open PDF file in column A, open and insert PDF file in column B, save as PDF file in column E
    
    For i = 1 To UBound(PDFfiles)
        objCAcroPDDocDestination.Open PDFfiles(i, 1)
        objCAcroPDDocSource.Open PDFfiles(i, 2)
        If Not objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
            MsgBox "Error merging" & vbCrLf & PDFfiles(i, 1) & vbCrLf & "and" & vbCrLf & PDFfiles(i, 2), vbExclamation
        End If
        objCAcroPDDocSource.Close
        objCAcroPDDocDestination.save 1, PDFfiles(i, 5)
        objCAcroPDDocDestination.Close
    Next
    
    Set objCAcroPDDocSource = Nothing
    Set objCAcroPDDocDestination = Nothing

    MsgBox "Done"
    
End Sub

I get a Run-time error '9' with my subscript out of range at the following point:
Code:
        objCAcroPDDocDestination.save 1, PDFfiles(i, 5)

I know I have not factored in the other files in column C and D at this point, but I thought to worry about merging first.

I appreciate if anyone can point me in the right direction. Much thanks in advance
 
Learn Excel from Bill Jelen

Understanding data is crucial, and the easiest place to start is with Microsoft Excel.

Forum statistics

Threads
1,151,697
Messages
5,765,987
Members
425,320
Latest member
Galin

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
Top