VBA: Combine PDFs and Export to Excel With Acrobat Pro?

180 Views Asked by At

my first time posting on this forum so grateful for any help I receive. I have been scouring the forums but not found anything that would work for what I need.

I need help with writing VBA code that will combine PDF files together in Adobe Acrobat Pro and export them into an excel file titled “Combined.xlsx” My computer is Windows 10 and I am using Excel 2016 and Adobe Acrobat Pro. My organization does not allow me to download anything additional. This VBA code runs out of an Excel Workbook and all referenced files are in the same folder. I have been using ThisWorkBook.Path and ThisWorkBook.FullName Could you please tell me if I should add any reference libraries for the code to work.

My current references

What I need VBA to do is:

  1. Open Adobe Acrobat Pro and Combine all PDFs that have “PR” somewhere in thir file name into a new PDF file
  2. Save that Combined PDF file as “pdfsCombined.pdf” to the folder if there are at least 5 PR pdf files
  3. Export that combined PDF file to a new excel file named “Combined.xlsx” where all pages of the Combined PDF go the same worksheet
  4. Close Adobe Acrobat Pro
  5. Copy Columns “A:AY” of “Combined.xlsx” into an existing worksheet named “Data” in the Excel Workbook running the VBA code
  6. Close “Combined.xlsx” without saving it

Why This Way: I want to automate this because manually doing it is slow and part of a system my coworkers will use so reducing user steps is a big help.
The code I have been using so far combines the PDFs easily and quickly but does not do it inside of adobe acrobat pro, which is a problem when it comes to exporting. After saving Combined PDFs, VBA opens the file in Adobe Acrobat Pro but cannot do any further action because of my organization’s locked security settings. All PDFs opened in Adobe Acrobat Pro require “Enable All Features” to be clicked. However, “Enable All Features” does not appear whenever Adobe Acrobat Pro combines the PDFs into a new PDF and that is why I would like to follow this approach. I tried exporting the PDFs to excel without using Adobe Acrobat Pro but that returns an unusable output.

Again, thank you for your help. Please let me know if I need to clarify anything.

The code I have so far is below:

Sub CombinePDFs()
'

Dim FileName As String
Dim Path As String
Dim PRPdfArray() As String

    
'Create Array of all PDFs in folder with "PR" in their name
Path = ThisWorkbook.Path & "\"
FileName = Dir(Path & "*PR*.pdf")

a = 0
Do While Len(FileName) > 0
    ReDim Preserve PRPdfArray(a)
    PRPdfArray(a) = FileName
    FileName = Dir
    a = a + 1
Loop
          
     
Dim PdfDst As AcroPDDoc, PdfSrc As AcroPDDoc
Dim sPdfComb As String, sPdf As String


'Set Combined Pdf filename - save the combined pdf in a new file in order to preserve original pdfs
sPdfComb = ThisWorkbook.Path & "\" & "Pdf Combined" & ".pdf"

test1 = Replace(PRPdfArray(0), ".pdf", "")
sPdf = ThisWorkbook.Path & "\" & test1 & ".pdf"

'Open Destination Pdf
Set PdfDst = New AcroPDDoc
If Not (PdfDst.Open(sPdf)) Then
End If


'Loop through the array and insert PDFs
Dim b As Byte
b = 0

Do
    'Set & Validate Source Pdf
    b = b + 1
    If b > UBound(PRPdfArray) Then Exit Do
    
    sPdf = ThisWorkbook.Path & "\" & PRPdfArray(b)

    'Open Source Pdf
    Set PdfSrc = New AcroPDDoc
    If Not (PdfSrc.Open(sPdf)) Then
    End If

        With PdfDst

            'Insert Source Pdf pages
            If Not (.InsertPages(-1 + .GetNumPages, PdfSrc, 0, PdfSrc.GetNumPages, 0)) Then
            End If
            
            'Save Combined Pdf
            If Not (.Save(PDSaveFull, sPdfComb)) Then
            End If
            
            PdfSrc.Close
            Set PdfSrc = Nothing

        End With
      
Loop

Exit_Sub:
    PdfDst.Close
     
'
End Sub

Sub CombinePDFsWithPRinName()
    Dim folderPath As String
    Dim fileName As String
    Dim acrobatApp As Object
    Dim pdfDoc As Object
    Dim pdfFile As Object
    Dim i As Integer
    
    ' Set the folder path where the PDF files are located
    folderPath = "C:\Path\to\PDFs"
    
    ' Create an instance of Adobe Acrobat
    On Error Resume Next
    Set acrobatApp = GetObject(, "AcroExch.App")
    If acrobatApp Is Nothing Then Set acrobatApp = CreateObject("AcroExch.App")
    On Error GoTo 0
    
    If acrobatApp Is Nothing Then
        MsgBox "Adobe Acrobat is either not installed or the automation server is not registered.", vbCritical
        Exit Sub
    End If
    
    ' Open a new PDF document
    Set pdfDoc = CreateObject("AcroExch.PDDoc")
    If Not pdfDoc.Open("") Then
        MsgBox "Failed to create a new PDF document.", vbCritical
        Set acrobatApp = Nothing
        Exit Sub
    End If
    
    ' Loop through all PDF files in the specified folder
    fileName = Dir(folderPath & "\*.pdf")
    While fileName <> ""
        ' Check if the file name contains "PR"
        If InStr(1, fileName, "PR", vbTextCompare) > 0 Then
            ' Open the PDF file
            Set pdfFile = CreateObject("AcroExch.PDDoc")
            If Not pdfFile.Open(folderPath & "\" & fileName) Then
                MsgBox "Failed to open PDF file: " & fileName, vbExclamation
            Else
                ' Append the PDF file to the new document
                If Not pdfDoc.InsertPages(pdfDoc.GetNumPages - 1, pdfFile, 0, pdfFile.GetNumPages, False) Then
                    MsgBox "Failed to combine PDF file: " & fileName, vbExclamation
                End If
                ' Close the PDF file
                pdfFile.Close
                Set pdfFile = Nothing
            End If
        End If
        ' Move to the next file
        fileName = Dir
    Wend
    
    ' Show the combined PDF document in Adobe Acrobat
    acrobatApp.Show
    acrobatApp.ShowToolbar "Show"
    acrobatApp.OpenAVDoc(pdfDoc)
    
    ' Cleanup
    Set pdfDoc = Nothing
    Set acrobatApp = Nothing
End Sub


Sub CombinePDFsWithPRinName()
    Dim folderPath As String
    Dim fileName As String
    Dim acrobatApp As Object
    Dim pdfDoc As Object
    Dim pdfFile As Object
    
    ' Set the folder path where the PDF files are located
    folderPath = "C:\Path\to\PDFs"
    
    ' Create an instance of Adobe Acrobat
    On Error Resume Next
    Set acrobatApp = GetObject(, "AcroExch.App")
    If acrobatApp Is Nothing Then Set acrobatApp = CreateObject("AcroExch.App")
    On Error GoTo 0
    
    If acrobatApp Is Nothing Then
        MsgBox "Adobe Acrobat is either not installed or the automation server is not registered.", vbCritical
        Exit Sub
    End If
    
    ' Create a new blank PDF document
    Set pdfDoc = acrobatApp.CreateAcroPDDoc
    If pdfDoc Is Nothing Then
        MsgBox "Failed to create a new PDF document.", vbCritical
        Set acrobatApp = Nothing
        Exit Sub
    End If
    
    ' Loop through all PDF files in the specified folder
    fileName = Dir(folderPath & "\*.pdf")
    While fileName <> ""
        ' Check if the file name contains "PR"
        If InStr(1, fileName, "PR", vbTextCompare) > 0 Then
            ' Open the PDF file
            Set pdfFile = acrobatApp.Open(folderPath & "\" & fileName)
            If Not pdfFile Is Nothing Then
                ' Append the PDF file to the new document
                If Not pdfDoc.InsertPages(pdfDoc.GetNumPages - 1, pdfFile.GetNumPages - 1, 0, pdfFile, 0) Then
                    MsgBox "Failed to combine PDF file: " & fileName, vbExclamation
                End If
                ' Close the PDF file
                pdfFile.Close
                Set pdfFile = Nothing
            Else
                MsgBox "Failed to open PDF file: " & fileName, vbExclamation
            End If
        End If
        ' Move to the next file
        fileName = Dir
    Wend
    
    ' Show the combined PDF document in Adobe Acrobat
    acrobatApp.Show
    acrobatApp.ShowToolbar "Show"
    acrobatApp.OpenPDF(pdfDoc)
    
    '

Sub CombinePDF() ' Declare variables Dim objAcrobat As Object Dim objDoc As Object Dim objNewDoc As Object Dim strFolderPath As String Dim strFileName As String Dim strNewFileName As String Dim intFileCount As Integer

' Set the folder path where the PDF files are located
strFolderPath = "C:\Path\to\PDF\Folder\"

' Create an instance of Adobe Acrobat Pro
Set objAcrobat = CreateObject("AcroExch.App")

' Enumerate through all the files in the folder
strFileName = Dir(strFolderPath & "*.pdf")
Do While strFileName <> ""
    ' Check if the file name contains "PR"
    If InStr(1, strFileName, "PR", vbTextCompare) > 0 Then
        ' Open the PDF file
        Set objDoc = objAcrobat.GetActiveDoc(strFolderPath & strFileName)
        
        ' Combine the PDF into a new PDF file
        If objNewDoc Is Nothing Then
            ' Create a new PDF document for the first file
            Set objNewDoc = objAcrobat.CreateNewDoc
            objNewDoc.InsertPages -1, objDoc, 0, objDoc.GetNumPages(), True
        Else
            ' Append the subsequent files to the new PDF document
            objNewDoc.InsertPages -1, objDoc, 0, objDoc.GetNumPages(), True
        End If
        
        ' Close the PDF file
        objDoc.Close
        
        ' Increment the file count
        intFileCount = intFileCount + 1
    End If
    
    ' Get the next file name
    strFileName = Dir
Loop

' Save and close the new PDF document (optional)
' strNewFileName = "Combined_PR.pdf"
' objNewDoc.Save 1, strFolderPath & strNewFileName
' objNewDoc.Close

' Display the new PDF document
objNewDoc.Open

' Release the objects
Set objAcrobat = Nothing
Set objDoc = Nothing
Set objNewDoc = Nothing

' Display the number of files combined
MsgBox "Combined " & intFileCount & " PDF(s) with 'PR' in their file name.", vbInformation

End Sub

0

There are 0 best solutions below