Combine multiple PDFs and delete the original files VBA

[ForrestGump01]

Hi all --

Trying to automate a PDF export from a spreadsheet that may contain multiple print ranges. My method right now is to save each print range as a file name and add "_PG#" after each page, and then use Acrobat to combine the pdf's into one file and delete the files with "_PG#".

My code saves down the multiple files just fine. However, I cannot get this to combine the files... Any ideas?

'---combine and delete pdfs---'
        MsgBox "Combinging Multi-page Order"
        
        If Sheet3.Range("J70").Value > 1 Then
            Dim objFSO As Object, objFolder As Object, objFile As Object
            Dim strFolderPath As String, strFileName As String
            Dim strFilePaths As String
            
            ' Set the folder path
            strFolderPath = Sheet3.Range("E72").Value
            
            ' Set the file name
            strFileName = Sheet3.Range("E71").Value
            
            ' Create a File System Object
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            
            ' Get the folder object
            Set objFolder = objFSO.GetFolder(strFolderPath)
            
            ' Loop through each file in the folder
            For Each objFile In objFolder.files
                ' Check if the file is a PDF file and contains the search text and "_PG"
                If Right(objFile.Name, 4) = ".pdf" And InStr(1, objFile.Name, Sheet3.Range("E71").Value) > 0 And InStr(1, objFile.Name, "_PG") > 0 Then
                    ' Add the file path to the string of file paths
                    strFilePaths = strFilePaths & objFile.Path & " "
                End If
            Next objFile
            
            ' Use the Adobe Acrobat Application to combine the PDF files
            Dim AcroApp As Object, PartDocs As Object, AVDoc As Object
            Dim NewDoc As Object, i As Integer
            
            ' Create a new instance of Adobe Acrobat
            Set AcroApp = CreateObject("AcroExch.App")
            Set PartDocs = CreateObject("AcroExch.PDDoc")
            Set NewDoc = CreateObject("AcroExch.PDDoc")
            
            ' Loop through each PDF file and add it to the PartDocs collection
            For i = 0 To UBound(Split(strFilePaths, " "))
                If PartDocs.Open(Split(strFilePaths, " ")(i)) Then
                    NewDoc.InsertPages NewDoc.GetNumPages - 1, PartDocs, 0, PartDocs.GetNumPages, False
                End If
            Next i
            
            ' Save the combined PDF document
            NewDoc.Save 1, strFolderPath & "\" & strFileName & ".pdf"
            
            ' Close the PDF files and exit Adobe Acrobat
            NewDoc.Close
            PartDocs.Close
            AcroApp.Exit

 

[John_w]

To merge PDFs, open the first PDF, which will become the final merged PDF, insert pages from the other PDFs and save the final merged PDF.

Note - I've used the Like operator with wildcards to find the matching "_PG#" PDFs. This code merges and deletes the "_PG#" PDFs.

'---combine and delete pdfs---'
        MsgBox "Combinging Multi-page Order"
        
        If Sheet3.Range("J70").Value > 1 Then
            Dim objFSO As Object, objFolder As Object, objFile As Object
            Dim strFolderPath As String, strFileName As String
            Dim strFilePaths As String
            
            ' Set the folder path
            strFolderPath = Sheet3.Range("E72").Value
            
            ' Set the file name
            strFileName = Sheet3.Range("E71").Value
            
            ' Use the Adobe Acrobat Application to combine the PDF files
            Dim AcroApp As Object, PartDocs As Object, AVDoc As Object
            Dim NewDoc As Object, i As Integer
            
            ' Create a new instance of Adobe Acrobat
            'Set AcroApp = CreateObject("AcroExch.App")
            Set PartDocs = CreateObject("AcroExch.PDDoc")
            Set NewDoc = Nothing
            
            ' Create a File System Object
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            
            ' Get the folder object
            Set objFolder = objFSO.GetFolder(strFolderPath)
            
            ' Loop through each file in the folder
            For Each objFile In objFolder.Files
                ' Check if the file is a PDF file and contains the search text and "_PG"
                If LCase(objFile.Name) Like LCase("*" & Sheet3.Range("E71").Value & "*_PG*.pdf") Then
                    If NewDoc Is Nothing Then
                        Set NewDoc = CreateObject("AcroExch.PDDoc")
                        NewDoc.Open objFile.Path
                        NewDoc.Save 1, strFolderPath & "\" & strFileName & ".pdf"
                    Else
                        PartDocs.Open objFile.Path
                        If Not NewDoc.InsertPages(NewDoc.GetNumPages - 1, PartDocs, 0, PartDocs.GetNumPages, 0) Then
                            MsgBox "Error merging " & objFile.Path, vbExclamation
                        End If
                        PartDocs.Close
                    End If
                    objFile.Delete
                End If
            Next objFile
            
            ' Save the final combined PDF document
            NewDoc.Save 1, strFolderPath & "\" & strFileName & ".pdf"
            
            ' Close the merged PDF file
            NewDoc.Close
            
        End If