Merging PDF's VBA

[jpsimmon]

So the first part of my code creates a PDF from my sheets, then I am trying to figure out a second part where it grabs two PDF's from one folder and saves them as one PDF in a spearate folder.

Sub PrintPages()

ThisWorkbook.Sheets(Array("Front Page", "Last Page")).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"s:\Location 1\PDF1.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

    Const MyPath = "S:\Location 1\"
    Const MyFiles = "PDF1.pdf,PDF2.pdf"
    Const DestFile = "MERGED PDF.pdf"

    Dim a As Variant, i As Long, n As Long, ni As Long, p As String
    Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc
    
    If Right(p, 1) = "\" Then p = "S:\Location 2\"
    a = Split(MyFiles, ",")
    ReDim PartDocs(0 To UBound(a))
    
    On Error GoTo exit_
    If Len(Dir(p & DestFile)) Then Kill p & DestFile
    For i = 0 To UBound(a)

        If Dir(p & Trim(a(i))) = "" Then
            MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled"
            Exit For
        End If

        Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
        PartDocs(i).Open p & Trim(a(i))
        If i Then

            ni = PartDocs(i).GetNumPages()
            If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
                MsgBox "Cannot insert pages of" & vbLf & p & a(i), vbExclamation, "Canceled"
            End If

            n = n + ni

            PartDocs(i).Close
            Set PartDocs(i) = Nothing
        Else

            n = PartDocs(0).GetNumPages()
        End If
    Next
     
    If i > UBound(a) Then

        If Not PartDocs(0).Save(PDSaveFull, p & DestFile) Then
            MsgBox "Cannot save the resulting document" & vbLf & p & DestFile, vbExclamation, "Canceled"
        End If
    End If
    
exit_:

    If Err Then
        MsgBox Err.Description, vbCritical, "Error #" & Err.Number
    ElseIf i > UBound(a) Then
        MsgBox "The resulting file is created:" & vbLf & p & DestFile, vbInformation, "Done"
    End If

    If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
    Set PartDocs(0) = Nothing
     
    AcroApp.Exit
    Set AcroApp = Nothing
End Sub

Thanks!

 

[kcmuppet]

Hi - did you solve this? I'm trying to work out how to solve a similar problem