Results 1 to 2 of 2

Thread: Help required on Merging PDFs using VBA

  1. #1
    Seeker amb2301's Avatar
    Join Date
    May 2020
    Excel Version
    excel 2013

    Help required on Merging PDFs using VBA

    Register for a FREE account, and/
    or Log in to avoid these ads!

    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

    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 by amb2301; 2020-06-05 at 01:14 AM.

  2. #2
    Seeker amb2301's Avatar
    Join Date
    May 2020
    Excel Version
    excel 2013
    attaching code here

    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
      ' 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
          Set PartDocs(i) = Nothing
           ' Calc the amount of pages in PartDocs(0) document
          n = PartDocs(0).GetNumPages()
        End If
      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
      ' 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
      'DoEvents: DoEvents
      Set AcroApp = Nothing
    End Sub

    no cross-posting done anywhere
    Attached Thumbnails Attached Thumbnails Click image for larger version. 

Name:	Capture.JPG 
Views:	4 
Size:	75.7 KB 
ID:	9839  
    Last edited by amb2301; 2020-06-05 at 01:24 AM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts