
Originally Posted by
swarmo
Hi guys,
Can anyone please help me? I need to have this macro reference a cell which determines the location of the PDF's. The locations and the names of the pdf's change for every job, based off the business name.
For example, cell A1 says C:\ACME Motors\Form\ACME Motors - Form.pdf
And A2 says C:\ACME Motors\Office Documents\ACME Motors - Office Form.pdf
And I need the merged PDF to be saved at A3 which says C:\ACME Motors\Final Documents\ACME Motors - Signed.pdf
Hi and welcome to VBAExpress!
Try this version of the code:
Sub Main()
Dim MyFiles As String, DestFile As String
With ActiveSheet
MyFiles = .Range("A1").Value & "," & .Range("A2").Value
DestFile = .Range("A3").Value
End With
Call MergePDFs01(MyFiles, DestFile)
End Sub
Sub MergePDFs01(MyFiles As String, DestFile As String)
' ZVI:2016-12-10 http://www.vbaexpress.com/forum/showthread.php?47310&p=353568&viewfull=1#post353568
' Reference required: VBE - Tools - References - Acrobat
Dim a As Variant, i As Long, n As Long, ni As Long
Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.AcroPDDoc
a = Split(MyFiles, ",")
ReDim PartDocs(0 To UBound(a))
On Error GoTo exit_
If Len(Dir(DestFile)) Then Kill DestFile
For i = 0 To UBound(a)
' Check PDF file presence
If Dir(Trim(a(i))) = "" Then
MsgBox "File not found" & vbLf & a(i), vbExclamation, "Canceled"
Exit For
End If
' Open PDF document
Set PartDocs(i) = New Acrobat.AcroPDDoc ' CreateObject("AcroExch.PDDoc")
PartDocs(i).Open Trim(a(i))
If i Then
' Merge PDF to PartDocs(0) document
ni = PartDocs(i).GetNumPages()
If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
MsgBox "Cannot insert pages of" & vbLf & a(i), vbExclamation, "Canceled"
End If
' Calc the amount of pages in the merged document
n = n + ni
' Release the memory
PartDocs(i).Close
Set PartDocs(i) = Nothing
Else
' Calc the amount of pages in PartDocs(0) document
n = PartDocs(0).GetNumPages()
End If
Next
If i > UBound(a) Then
' Save the merged document to DestFile
If Not PartDocs(0).Save(PDSaveFull, DestFile) Then
MsgBox "Cannot save the resulting document" & vbLf & DestFile, vbExclamation, "Canceled"
End If
End If
exit_:
' Inform about error/success
If Err Then
MsgBox Err.Description, vbCritical, "Error #" & Err.Number
ElseIf i > UBound(a) Then
MsgBox "The resulting file is created:" & vbLf & DestFile, vbInformation, "Done"
End If
' Release the memory
If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
Set PartDocs(0) = Nothing
' Quit Acrobat application
AcroApp.Exit
'DoEvents: DoEvents
Set AcroApp = Nothing
End Sub
Best Regards!