Public Sub Merge_PDFs2()
Dim PDFfiles As Variant
Dim i As Long
Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
Dim tempFolder As String, outputPDF As String
tempFolder = Environ("temp") & "\"
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, copy PDF files in columns A and B to temp folder, merge them and save in temp folder and copy merged file to PDF file in column C
For i = 1 To UBound(PDFfiles)
Debug.Print tempFolder & Mid(PDFfiles(i, 1), InStrRev(PDFfiles(i, 1), "\") + 1)
FileCopy PDFfiles(i, 1), tempFolder & Mid(PDFfiles(i, 1), InStrRev(PDFfiles(i, 1), "\") + 1)
PDFfiles(i, 1) = tempFolder & Mid(PDFfiles(i, 1), InStrRev(PDFfiles(i, 1), "\") + 1)
FileCopy PDFfiles(i, 2), tempFolder & Mid(PDFfiles(i, 2), InStrRev(PDFfiles(i, 2), "\") + 1)
PDFfiles(i, 2) = tempFolder & Mid(PDFfiles(i, 2), InStrRev(PDFfiles(i, 2), "\") + 1)
outputPDF = PDFfiles(i, 3)
PDFfiles(i, 3) = tempFolder & Mid(PDFfiles(i, 3), InStrRev(PDFfiles(i, 3), "\") + 1)
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 Acrobat.PDSaveFlags.PDSaveFull, PDFfiles(i, 3)
objCAcroPDDocDestination.Close
FileCopy PDFfiles(i, 3), outputPDF
Next
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing
MsgBox "Done"
End Sub