Consulting

Results 1 to 11 of 11

Thread: Merge PDF

  1. #1
    VBAX Regular
    Joined
    Dec 2019
    Posts
    6
    Location

    Merge PDF

    Hello,
    I come to you for a little help, I have a folder with several hundred PDF files, they are named:

    ABC DEF 1234567 GH 111111_111_IJKL MNOPQRSTUVW_X.pdf
    ZYXWVUTSRNBY_QPON_MLK JIH 1234567 GF 00000000_0000_EDCBA ZYXWUTSRN.pdf

    I want to make a macro to merge the two files, knowing that what changes every time is 1234567
    (by recovering one of the two names), and after once merged recover the name of the files in the Excel sheet.
    I found a code on your site, it works fine, but it merges all the files with a different name

    Sub Main()

    Dim DestFile As String

    Dim MyPath As String, MyFiles As String
    Dim a() As String, i As Long, f As String, Arr

    With Application.FileDialog(msoFileDialogFolderPicker)
    '.InitialFileName = "D:\Dropbox\User\All Entities\Financials\Company A, LLC"
    .AllowMultiSelect = False
    If .Show = False Then Exit Sub
    MyPath = .SelectedItems(1)
    DoEvents
    End With

    ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "" Then MyPath = MyPath & ""

    '--> ZVI:2018-11-08 Build DestFile using 2 last (sub)folders
    Arr = Split(MyPath, "")
    If UBound(Arr) > 2 Then DestFile = Arr(UBound(Arr) - 1)
    If UBound(Arr) > 3 Then DestFile = Arr(UBound(Arr) - 2) & " - " & DestFile & " - "
    DestFile = DestFile & "Financial Statement.pdf"
    '<--

    ReDim a(1 To 2 ^ 14)
    f = Dir(MyPath & "*.pdf")
    While Len(f)
    If StrComp(f, DestFile, vbTextCompare) Then
    i = i + 1
    If Not LCase(f) Like "*.pdf" Then f = f & "*.pdf" ' <-- ZVI:2018-11-08
    a(i) = f
    End If
    f = Dir()
    Wend

    ' Merge PDFs
    If i Then
    ReDim Preserve a(1 To i)
    MyFiles = Join(a, vbTab) ' <-- ZVI:2018-12-19
    Application.StatusBar = "Merging, please wait ..."
    Call MergePDFs(MyPath, MyFiles, DestFile)
    Application.StatusBar = False
    Else
    MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
    End If

    End Sub

    Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")
    ' ZVI:2013-08-27
    ' Reference required: VBE - Tools - References - Acrobat XX.0 Type Library

    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, vbTab) ' <-- ZVI:2018-12-19
    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 & a(i)) = "" Then ' <-- ZVI:2018-11-08 Without Trim()
    MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled, i=" & i
    Exit For
    End If
    ' Open PDF document
    Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
    PartDocs(i).Open p & a(i) '<--ZVI:2018-11-08 without Trim()
    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"
    PartDocs(i).Close
    Set PartDocs(i) = Nothing
    Exit Sub
    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

    Thank you in advance for the help you can give me.
    Last edited by safwaty; 12-18-2019 at 03:13 AM.

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Please paste code between code tags. Click the # icon in reply toolbar to insert the tags. It makes code easier to troubleshoot and avoids character translation issues.

    I don't understand. You say you have hundreds in a folder but just want to merge just two. I don't know what recover the name of the files means.

    The code creates one merged pdf. Change the value of the inputs to suit. e.g.
    'Call MergePDFs(MyPath, MyFiles, DestFile)
    MergePDFs MyPath, "ABC DEF 1234567 GH 111111_111_IJKL MNOPQRSTUVW_X.pdf" & vbTab & "ZYXWVUTSRNBY_QPON_MLK JIH 1234567 GF 00000000_0000_EDCBA ZYXWUTSRN.pdf", DestFile
    You can reference a link if needed. I don't think that you can paste the link until 5 posts. You can say post 66468 for example if you referenced this thread though your pasted routine from ZVI would suffice.

  3. #3
    VBAX Regular
    Joined
    Dec 2019
    Posts
    6
    Location
    Hello,
    Thank you for the help you give me
    To be more clear: the 2 names that files correspond to the characters of my files saved in my folders
    So I have 2 types of PDF files I want to merge by the name of the files knowing that the names of the files are variable and what which remains in common is what I underlined

    Example 1:

    Bon SAV S013850 du 20190905_1040_PART DEGROOTE_T.pdf
    Implantation_Parc_Bon SAV S013850 du 20190905_1040_PART DEGROOTE_T.pdf

    Example 2:

    Bon SAV S013852 du 20190905_1108_PART BAILLON_T.pdf
    Implantation_Parc_Bon SAV S013852 du 20190905_1108_PART BAILLON_T.pdf


    Thank you for your help
    (sorry for my english google)

    Sub Main()
    
    Dim DestFile As String
    
    Dim MyPath As String, MyFiles As String
    Dim a() As String, i As Long, f As String, Arr
    
    With Application.FileDialog(msoFileDialogFolderPicker)
    '.InitialFileName = "D:\Dropbox\User\All Entities\Financials\Company A, LLC"
    .AllowMultiSelect = False
    If .Show = False Then Exit Sub
    MyPath = .SelectedItems(1)
    DoEvents
    End With
    
    ' Populate the array a() by PDF file names
    If Right(MyPath, 1) <> "" Then MyPath = MyPath & ""
    
    '--> ZVI:2018-11-08 Build DestFile using 2 last (sub)folders
    Arr = Split(MyPath, "")
    If UBound(Arr) > 2 Then DestFile = Arr(UBound(Arr) - 1)
    If UBound(Arr) > 3 Then DestFile = Arr(UBound(Arr) - 2) & " - " & DestFile & " - "
    DestFile = DestFile & "Financial Statement.pdf"
    '<--
    
    ReDim a(1 To 2 ^ 14)
    f = Dir(MyPath & "*.pdf")
    While Len(f)
    If StrComp(f, DestFile, vbTextCompare) Then
    i = i + 1
    If Not LCase(f) Like "*.pdf" Then f = f & "*.pdf" ' <-- ZVI:2018-11-08
    a(i) = f
    End If
    f = Dir()
    Wend
    
    ' Merge PDFs
    If i Then
    ReDim Preserve a(1 To i)
    MyFiles = Join(a, vbTab) ' <-- ZVI:2018-12-19
    Application.StatusBar = "Merging, please wait ..."
    Call MergePDFs(MyPath, MyFiles, DestFile)
    Application.StatusBar = False
    Else
    MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
    End If
    
    End Sub
    
    Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")
    ' ZVI:2013-08-27
    ' Reference required: VBE - Tools - References - Acrobat XX.0 Type Library
    
    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, vbTab) ' <-- ZVI:2018-12-19
    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 & a(i)) = "" Then ' <-- ZVI:2018-11-08 Without Trim()
    MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled, i=" & i
    Exit For
    End If
    ' Open PDF document
    Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
    PartDocs(i).Open p & a(i) '<--ZVI:2018-11-08 without Trim()
    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"
    PartDocs(i).Close
    Set PartDocs(i) = Nothing
    Exit Sub
    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

  4. #4
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    It looks like you want to merge two files if the 3rd word in each is the same? I guess there could be cases where no 2 files had that or where more than 2 had that.

    If you have that 3rd word in an Excel range, that could be another way to handle the files.

    I whichever case, once merged, those should be removed from further processing. A dictionary object makes adding and removing the file names easier.

  5. #5
    VBAX Regular
    Joined
    Dec 2019
    Posts
    6
    Location
    It seems that you want to merge two files if the third word of each is the same?
    It's exactly that.

    I suppose there could be cases where no file contained this or more than 2 files contained it?
    no all the time it's the 3rd word.

    In any case, once merged, these must be removed from further processing
    Yes I want to recover one of the two names of the files

    Thank you

  6. #6
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    I suppose there could be cases where no file contained this or more than 2 files contained it?
    no all the time it's the 3rd word.
    What I mean is that one file has a unique 3rd word, two files have the same 3rd word, or three files or more have that same 3rd word.


    Yes I want to recover one of the two names of the files
    I still don't know what recover means. Maybe if at least two files have the same 3rd word, then write the base filename of the 1st file to a range?

    I think that I would call the merged file, that 3rd word. e.g.
    "xx yy 123 zz.pdf" and "xx xx 123.pdf", merged to say 123.pdf. I am not sure that I would merge it to the same folder but we can look at that later if needed.

    When I get time tonight maybe, I can post a solution.

    There are other 3rd party programs that can do the merge as well. e.g. pdftk, pdfill, pdfsam, etc. The main thing is to get the code to get all the files from a folder and then match merge based on 3rd word.

    I showed how to use some of those methods in: http://www.vbaexpress.com/forum/show...and-Subfolders

  7. #7
    VBAX Regular
    Joined
    Dec 2019
    Posts
    6
    Location
    Thank you in advance for your precious help

  8. #8
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Since not all have Acrobat, I made a pseudo merge routine with the same name to show if the right inputs were sent to it.

    Sub MergePDFsByWord3()  
      Dim d As Object
      'Dim d As Scripting.Dictionary
      Dim i As Integer, b, f
      Dim DestFile As String, MyPath As String, MyFiles As String
      Dim a() As String
      
      MyPath = "C:\Users\lenovo1\Dropbox (Personal)\_Excel\pdf\t"
      With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = MyPath
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
      End With
      
      If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
      
      a = Split(CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
        """" & MyPath & "*.pdf" & """" & " /b").StdOut.ReadAll, vbCrLf)
    
    
      Set d = CreateObject("Scripting.Dictionary")
      d.CompareMode = 1 'TextCompary=1, BinaryCompare=0
      For i = 1 To UBound(a)
        b = Split(a(i))
        'IF 3rd word exists, add unique word to dictionary:
        If UBound(b) > 1 Then If Not d.Exists(b(2)) Then d.Add b(2), Nothing
      Next i
    
    
      b = d.Keys
      If d.Count > 0 Then
        For i = 0 To UBound(b)
          f = Filter(a, " " & b(i), True, vbTextCompare)
          MergePDFs MyPath, Join(f, vbTab), b(i) & " - Financial Statement.pdf"
        Next i
      End If
      
      Set d = Nothing
    End Sub
    
    
    Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")
      MsgBox "MyPath: " & MyPath & vbLf & vbLf & "MyFiles:" & vbLf & Replace(MyFiles, vbTab, vbLf) & _
        vbLf & vbLf & "DestFile: " & DestFile
    End Sub

  9. #9
    VBAX Regular
    Joined
    Dec 2019
    Posts
    6
    Location
    Hello,
    thank you everything works fine but would there be a way to cancel the confirmation message for each merger?

  10. #10
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Comment out that msgbox line or delete it or change it to debug.print.

  11. #11
    VBAX Regular
    Joined
    Dec 2019
    Posts
    6
    Location
    thank you everything works fine

Posting Permissions

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