Dear VBA Specialists,
I want to create a macro which merges multiple PDF files, but the amount of files that has to be merged is variable and need to be determined in the excelsheet. So my wish is to gain a VBA code that reads the filenames out of a folder, Somehow select which ones should merged into the same file and let Adobe Acrobat Pro do the rest.
I have achieved to get a code running that reads out a folder and projets the filename and path in the sheet (column A and B). Now should be selected which files belong in the same combined PDF. My best guess is to write down the name of the future merged filename in column C...? And adjust the code to that system.
Online are some examples of VBA code that could merge PDF files but not exactly working like how I imagine. Below are two codes projected that might can be adjusted to serve this purpose.
This raises the question if it makes sense to let it work how I described over here?
If you can have any advice or can help me out with making this work, that would be very much appreciated!
Kind regards,
Edwin
Sub MergePDFs() 'Code 1'
'Dim arrayFilePaths() As Variant
Set app = CreateObject("Acroexch.app")
arrayFilePaths = Array("mypath.pdf", _
"mypath2.pdf")
Set primaryDoc = CreateObject("AcroExch.PDDoc")
OK = primaryDoc.Open(arrayFilePaths(0))
Debug.Print "PRIMARY DOC OPENED & PDDOC SET: " & OK
For arrayIndex = 1 To UBound(arrayFilePaths)
numPages = primaryDoc.GetNumPages() - 1
Set sourceDoc = CreateObject("AcroExch.PDDoc")
OK = sourceDoc.Open(arrayFilePaths(arrayIndex))
Debug.Print "SOURCE DOC OPENED & PDDOC SET: " & OK
numberOfPagesToInsert = sourceDoc.GetNumPages
OK = primaryDoc.InsertPages(numPages, sourceDoc, 0, numberOfPagesToInsert, False)
Debug.Print "PAGES INSERTED SUCCESSFULLY: " & OK
OK = primaryDoc.Save(PDSaveFull, arrayFilePaths(0))
Debug.Print "PRIMARYDOC SAVED PROPERLY: " & OK
Set sourceDoc = Nothing
Next arrayIndex
Set primaryDoc = Nothing
app.Exit
Set app = Nothing
MsgBox "DONE"
End Sub
Sub Combine() 'Code 2'
' Reference required: "VBE - Tools - References - Acrobat"
' --> Settings, change to suit
Const MyPath = "C:blabla" ' Path where PDF files are stored
Const MyFiles = "1." ' List of PDFs to ne merged
Const DestFile = "MergedFile.pdf" ' The name of the merged file
' <-- End of settings
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(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"
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)
' Check PDF file presence
If Dir(p & Trim(a(i))) = "" Then
MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled"
Exit For
End If
' Open PDF document
Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
PartDocs(i).Open p & 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 & p & a(i), vbExclamation, "Canceled"
End If
' Calc the number of pages in the merged document
n = n + ni
' Release the memory
PartDocs(i).Close
Set PartDocs(i) = Nothing
Else
' Calc the number 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, p & DestFile) Then
MsgBox "Cannot save the resulting document" & vbLf & p & 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 & p & 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
Set AcroApp = Nothing
End Sub
1
Reply
AdChoices