Help required on Merging PDFs using VBA

amb2301

New member
Joined
May 18, 2020
Messages
15
Reaction score
0
Points
0
Excel Version(s)
excel 2013
Hi Friends,

My Current Task:
Actually i have multiple folders (Folder1,Folder2,.....Folderx) each folder contains 5 standard sub-folders (Wordx, PDF1, PDF2, output, other)

now i have a task like... to open (Folder1)main folder & merge PDF files from different Subfolders (Wordx, PDF1, PDF2) and finally merged PDF has to be kept in subfolder (Output).
to do this task i found a script from
http://www.vbaexpress.com/forum/showthread.php?47310&p=353568&viewfull=1#post353568

this script working fine for merging PDFs inside the sub folders
But the problem is.. everytime i need to mention till filename in excel range
like D:\RXT teams\documents\Folder1\Wordx\Level1.pdf.

is it possible to just give till D:\RXT teams\documents\Folder1\Wordx\
& consider the PDFs inside that folder for merging?

Kindly help me to complete my task.

Thanks in Advance.
 
Last edited:
attaching code here

Code:
Sub Main()  Dim MyFiles As String, DestFile As String
  With ActiveSheet
    MyFiles = .Range("d19").Value & "," & .Range("d20").Value & "," & .Range("d21").Value
    DestFile = .Range("d22").Value
  End With
  Call MergePDFs01(MyFiles, DestFile)
End Sub
 
Sub MergePDFs01(MyFiles As String, DestFile As String)
    ' ZVI:2016-12-10 http://www.vbaexpress.com/forum/showthread.php?47310&p=353568&viewfull=1#post353568
  ' Reference required: VBE - Tools - References - Acrobat
 
  Dim a As Variant, i As Long, n As Long, ni As Long
  Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.AcroPDDoc
 
  a = Split(MyFiles, ",")
  ReDim PartDocs(0 To UBound(a))
 
  On Error GoTo exit_
  If Len(Dir(DestFile)) Then Kill DestFile
  For i = 0 To UBound(a)
    ' Check PDF file presence
    If Dir(Trim(a(i))) = "" Then
      MsgBox "File not found" & vbLf & a(i), vbExclamation, "Canceled"
      Exit For
    End If
    ' Open PDF document
    Set PartDocs(i) = New Acrobat.AcroPDDoc ' CreateObject("AcroExch.PDDoc")
    PartDocs(i).Open 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 & a(i), vbExclamation, "Canceled"
      End If
       ' Calc the amount of pages in the merged document
      n = n + ni
      ' Release the memory
      PartDocs(i).Close
      Set PartDocs(i) = Nothing
    Else
       ' Calc the amount 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, DestFile) Then
      MsgBox "Cannot save the resulting document" & vbLf & 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 & 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
  'DoEvents: DoEvents
  Set AcroApp = Nothing
 
End Sub


no cross-posting done anywhere
 

Attachments

  • Capture.JPG
    Capture.JPG
    75.7 KB · Views: 14
Last edited:
Back
Top