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.
What I need VBA to do is:
- Open Adobe Acrobat Pro and Combine all PDFs that have “PR” somewhere in thir file name into a new PDF file
- Save that Combined PDF file as “pdfsCombined.pdf” to the folder if there are at least 5 PR pdf files
- Export that combined PDF file to a new excel file named “Combined.xlsx” where all pages of the Combined PDF go the same worksheet
- Close Adobe Acrobat Pro
- Copy Columns “A:AY” of “Combined.xlsx” into an existing worksheet named “Data” in the Excel Workbook running the VBA code
- 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