I am trying to combine linked PDFs in my excel document. Below is my code but it does not work. Any thoughts or suggestions?
Option Explicit
Sub insert_PDF()
Dim AcroApp As Acrobat.CAcroApp
Dim targetpdf As Acrobat.CAcroPDDoc
Dim sourcePDF As Acrobat.CAcroPDDoc
Dim i As Long
Dim j As Long
Dim sLink As String
Dim success As Long
Dim counter As Long
Dim last_row As Long
Dim sourceNumPages As Long
Dim targetNumPages As Long
Set AcroApp = CreateObject("AcroExch.App")
Set targetpdf = CreateObject("AcroExch.PDDoc")
'find the last non-blank row in Column A
'there should be no blank cells before the last cell in Column A
last_row = Sheets(1).Range("A65536").End(xlUp).Row
'open the first link whose I column value is not "no"
For i = 2 To 34
If UCase(Sheet2.Range("J" & i).Value) = "YES" Then
If Range("A" & i).Hyperlinks.Count > 0 Then
' Set hyperlink in column A if it exists
sLink = Range("A" & i).Hyperlinks(1).Address
success = targetpdf.Open(sLink)
Exit For
End If
End If
Next i
'if column I has no "yes"
If i = 34 Then
MsgBox ("Cannot find yes. No link to open. Exit program....")
Exit Sub
End If
'find the number of pages in the target PDF file
targetNumPages = targetpdf.GetNumPages
'insert files to targetPDF from sourcePDF
Set sourcePDF = CreateObject("AcroExch.PDDoc") 'content to be pasted
For counter = i + 1 To 34
If UCase(Sheet2.Range("J" & i).Value) = "YES" Then
sLink = Range("A" & i).Hyperlinks(1).Address
success = sourcePDF.Open(sLink)
sourceNumPages = sourcePDF.GetNumPages
j = targetpdf.InsertPages(targetNumPages - 1, sourcePDF, 0, sourceNumPages, 0)
End If
sourcePDF.Close
Next counter
Debug.Print "targetpdf"
'save file to C:\temp\MergedFile.pdf <- need to be changed to suit your need
If targetpdf.Save(PDSaveFull, "C:\Users\bpikus\Desktop\Test.pdf") = False Then
MsgBox "Cannot save the modified document"
End If
targetpdf.Close
sourcePDF.Close
AcroApp.Exit
Set AcroApp = Nothing
Set targetpdf = Nothing
Set sourcePDF = Nothing
MsgBox "Done"
End Sub
Option Explicit
Sub insert_PDF()
Dim AcroApp As Acrobat.CAcroApp
Dim targetpdf As Acrobat.CAcroPDDoc
Dim sourcePDF As Acrobat.CAcroPDDoc
Dim i As Long
Dim j As Long
Dim sLink As String
Dim success As Long
Dim counter As Long
Dim last_row As Long
Dim sourceNumPages As Long
Dim targetNumPages As Long
Set AcroApp = CreateObject("AcroExch.App")
Set targetpdf = CreateObject("AcroExch.PDDoc")
'find the last non-blank row in Column A
'there should be no blank cells before the last cell in Column A
last_row = Sheets(1).Range("A65536").End(xlUp).Row
'open the first link whose I column value is not "no"
For i = 2 To 34
If UCase(Sheet2.Range("J" & i).Value) = "YES" Then
If Range("A" & i).Hyperlinks.Count > 0 Then
' Set hyperlink in column A if it exists
sLink = Range("A" & i).Hyperlinks(1).Address
success = targetpdf.Open(sLink)
Exit For
End If
End If
Next i
'if column I has no "yes"
If i = 34 Then
MsgBox ("Cannot find yes. No link to open. Exit program....")
Exit Sub
End If
'find the number of pages in the target PDF file
targetNumPages = targetpdf.GetNumPages
'insert files to targetPDF from sourcePDF
Set sourcePDF = CreateObject("AcroExch.PDDoc") 'content to be pasted
For counter = i + 1 To 34
If UCase(Sheet2.Range("J" & i).Value) = "YES" Then
sLink = Range("A" & i).Hyperlinks(1).Address
success = sourcePDF.Open(sLink)
sourceNumPages = sourcePDF.GetNumPages
j = targetpdf.InsertPages(targetNumPages - 1, sourcePDF, 0, sourceNumPages, 0)
End If
sourcePDF.Close
Next counter
Debug.Print "targetpdf"
'save file to C:\temp\MergedFile.pdf <- need to be changed to suit your need
If targetpdf.Save(PDSaveFull, "C:\Users\bpikus\Desktop\Test.pdf") = False Then
MsgBox "Cannot save the modified document"
End If
targetpdf.Close
sourcePDF.Close
AcroApp.Exit
Set AcroApp = Nothing
Set targetpdf = Nothing
Set sourcePDF = Nothing
MsgBox "Done"
End Sub