Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 25

Thread: Make Array with Full Paths to PDF Files in Parent and Subfolders

  1. #1

    Make Array with Full Paths to PDF Files in Parent and Subfolders

    Hi

    I have taken ZVIs code and modified it to suit my needs. It works up to a point but I am trying to do a bit more with it and have become unstuck so it's back to the board.

    I have 20 folders each containing 6 files (can change but leaving to 20 folders and 6 files in each for this example).

    I am trying to do 2 things:

    1. merge the 6 files in each subfolder to create a new mergedPDF
    2. copy the (new) 20 merged files in each subfolder into a new folder. The 20 files in the new folder are NOT to be merged.


    I think my request may be a batch processing one and one where I need a loop. Can anyone help?

    I have commented out some lines as I was trying to get this to work with Adobe Acrobat but also PDFCreator and they both needed different References in the library.

    Sub Main()
       
        Const DestFile As String = "MergedFile.pdf" ' <-- change to suit
       
        Dim MyPath As String, MyFiles As String
        Dim a() As String, i As Long, f As String
       
         ' Choose the folder or just replace that part by: MyPath = Range("E3")
        With Application.FileDialog(msoFileDialogFolderPicker)
             '.InitialFileName = "C:\Temp\"
            .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 & "\"
        ReDim a(1 To 2 ^ 14)
        f = Dir(MyPath & "*.pdf")
        While Len(f)
            If StrComp(f, DestFile, vbTextCompare) Then
                i = i + 1
                a(i) = f
            End If
            f = Dir()
        Wend
       
        ' Merge PDFs
        If i Then
            ReDim Preserve a(1 To i)
            MyFiles = Join(a, ",")
            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 http://www.vbaexpress.com/forum/showthread.php?47310-Need-code-to-merge-PDF-files-in-a-folder-using-adobe-acrobat-X
    ' Reference required: VBE - Tools - References - Acrobat
     
        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
    'Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
    'Dim objCAcroPDDocSource 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
     
    objCAcroPDDocDestination.Save 1, strSaveAs 'Save it as a new name
    objCAcroPDDocDestination.Close
    'Set objCAcroPDDocSource = Nothing
    'Set objCAcroPDDocDestination = Nothing
     
         'Quit Acrobat application
         AcroApp.Exit
         Set AcroApp = Nothing
     
    End Sub

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,645
    To retrieve all PDF-files in folder "G:\OF" and its subfolders:

    Sub M_snb()
      msgbox createobject("wscript.shell").exec("cmd /c Dir ""G:\OF\*.pdf"" /b/s").stdout.readall
    End Sub

  3. #3
    Thanks snb.

    If I understand your post correctly this will copy/retrieve all files in the subfolder into a new folder? Issue I have is that I only want the merged files in the subfolders copying out into a new folder.

  4. #4
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,645
    I described the function of the macro in my post.
    If you want to understand the post correctly you will have to run the macro.

  5. #5
    Thanks snb. Sorry couldn't test it earlier hence the question but have tested it now.

    The macro gives a list of names in the folder which is useful in itself however I am trying to merge the files and copy across the merged files (only) in each of the subfolders into a new folder as per post 1.
    Last edited by branston; 10-11-2019 at 10:10 AM.

  6. #6
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Trigger warning, the screen will flash each time a subfolder is processed using this method. If needed, I can code it to use another method. One flash is usually ok but many can be a problem for some people.

    I marked lines in red that you can comment out to not do the merge but test it otherwise.

    I used Wells' pdfmerge() routine. I do not have Acrobat on this computer so I can not test the slight tweak that I did to it.

    I think you wanted the merged pdf in each subfolder and another copy in another folder. If not, you can modify the lines in red. Obviously, you do need to change the values for the folders p and p2.
    Sub IterateSubfolders()    
        Dim a, f, i As Long, j As Long, pdf As String, p As String, tf As Boolean
        Dim p2 As String
        
        'Parent folder
        'p = ThisWorkbook.Path & "\"
        p = "C:\Users\lenovo1\Dropbox\_Excel\pdf\Acrobat\"
        
        'Folder to copy merged pdf to
        p2 = p
        
        'SubFolders Array
        f = aFFs(p, "/ad", True)
    
    
        'Merge pdfs in Parent folder, save copy there, and copy to p2 folder.
        a = aFFs(p & "*.pdf")
        If IsArray(a) Then
            ReDim Preserve f(UBound(f) - 1)
            j = j + 1
            pdf = p & "PDF_" & j & ".pdf"
            If MergePDF(a, pdf) Then FileCopy pdf, p2 & "PDF_" & j & ".pdf"
        End If
        
        'Merge pdfs in Subfolders, save merged file in subfolders,
            'and copy merged pdf to p2 folder.
        For i = 0 To UBound(f)
           a = aFFs(f(i) & "\*.pdf")
           If IsArray(a) Then
                j = j + 1
                pdf = f(i) & "PDF_" & j & ".pdf"
                If MergePDF(a, pdf) Then FileCopy pdf, p2 & "PDF_" & j & ".pdf"
            End If
        Next i
    End Sub
    
    
    'Set extraSwitches, e.g. "/ad", to search folders only.
    'MyDir should end in a "\" character unless searching by wildcards, e.g. "x:\test\t*
    'Command line switches for the shell's Dir, http://ss64.com/nt/dir.html
    Function aFFs(myDir As String, Optional extraSwitches = "", _
      Optional tfSubFolders As Boolean = False) As Variant
      
      Dim s As String, a() As String, v As Variant
      Dim b() As Variant, i As Long
      
      If tfSubFolders Then
        s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
          """" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
        Else
        s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
          """" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
      End If
      
      a() = Split(s, vbCrLf)
      If UBound(a) = -1 Then
        'Debug.Print myDir & " not found.", vbCritical, "Macro Ending"
        Exit Function
      End If
      ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr
      
      For i = 0 To UBound(a)
        If Not tfSubFolders Then
          s = Left$(myDir, InStrRev(myDir, "\"))
          'add the folder name
          a(i) = s & a(i)
        End If
      Next i
      aFFs = sA1dtovA1d(a)
    End Function
    
    
    Function sA1dtovA1d(strArray() As String) As Variant
      Dim varArray() As Variant, i As Long
      ReDim varArray(LBound(strArray) To UBound(strArray))
      For i = LBound(strArray) To UBound(strArray)
        varArray(i) = CVar(strArray(i))
      Next i
      sA1dtovA1d = varArray()
    End Function
    
    
    'https://wellsr.com/vba/2017/word/combine-pdfs-with-vba-and-adobe-acrobat/
    'Private Function MergePDF(arrFiles() As String, strSaveAs As String) As Boolean
    Private Function MergePDF(arrFiles, strSaveAs As String) As Boolean
        '---------------------------------------------------------------------------------------------------
        '---PROGRAM: MergePDFs------------------------------------------------------------------------------
        '---DEVELOPER: Ryan Wells (wellsr.com)--------------------------------------------------------------
        '---DATE: 09/2017-----------------------------------------------------------------------------------
        '---DESCRIPTION: This function uses Adobe Acrobat (won't work with just the Reader!) to-------------
        '--- combine PDFs into one PDF and save the new PDF with its own file name.-------------
        '---INPUT: The function requires two arguments.-----------------------------------------------------
        '--- 1) arrFiles is an array of strings containing the full path to each PDF you want to------
        '--- combine in the order you want them combined.------------------------------------------
        '--- 2) strSaveAs is a string containing the full path you want to save the new PDF as.-------
        '---REQUIREMENTS: 1) Must add a reference to "Adobe Acrobat X.0 Type Library" or "Acrobat"----------
        '--- under Tools > References. This has been tested with Acrobat 6.0 and 10.0.------
        '---CAUTION: This function won't work unless you have the full Adobe Acrobat. In other words,-------
        ' Adobe Reader will not work.------------------------------------------------------------
        '---------------------------------------------------------------------------------------------------
         
        Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
        Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
        Dim i As Integer
        Dim iFailed As Integer
         
        On Error GoTo NoAcrobat:
        'Initialize the Acrobat objects
        Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
        Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
         
        'Open Destination, all other documents will be added to this and saved with
        'a new filename
        objCAcroPDDocDestination.Open (arrFiles(LBound(arrFiles))) 'open the first file
         
        'Open each subsequent PDF that you want to add to the original
          'Open the source document that will be added to the destination
            For i = LBound(arrFiles) + 1 To UBound(arrFiles)
                objCAcroPDDocSource.Open (arrFiles(i))
                If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
                  MergePDF = True
                Else
                  'failed to merge one of the PDFs
                  iFailed = iFailed + 1
                End If
                objCAcroPDDocSource.Close
            Next i
        objCAcroPDDocDestination.Save 1, strSaveAs 'Save it as a new name
        objCAcroPDDocDestination.Close
        Set objCAcroPDDocSource = Nothing
        Set objCAcroPDDocDestination = Nothing
         
    NoAcrobat:
        If iFailed <> 0 Then
            MergePDF = False
        End If
        On Error GoTo 0
    End Function

  7. #7
    Thanks Ken - that's a great help.

    The flashes are not a major issue for now but long term I can imagine them being an issue if I was using for example 100 subfolders.

    I ran a test and have attached a screen shot of the output. Not sure why getting two lots of the same output? I think PDF_1.pdf and PDF_2.pdf needed to be in the Folder 1 and Folder 2 and Folder 1PDF_1.pdf and Folder 1PDF_2.pdf needed to actually be inside a new folder. And actually since the desired output is Folder 1PDF_1.pdf and Folder 1PDF_2.pdf inside a new folder, PDF_1.pdf and PDF_2.pdf are not needed as they are the same files as
    Folder 1PDF_1.pdf and
    Folder 1PDF_2.pdf

    Could you take a look please?
    Attached Images Attached Images

  8. #8
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Maybe the parent folder was in f array. Delete the merged pdfs and comment out the first red line. If that works, you can delete the whole section.

  9. #9
    Ermm .. not sure Ken as commenting out the first red line is giving me the same output as post #7

    I can't see where a 'new' folder is created where all the merged pdf are stored? Should there not be a new folder created in the code below once the files are merged ie. something like "..\Acrobat\MergedFilesFolder\(all 20 merged files here)"

    'Parent folder 'p = ThisWorkbook.Path & "\" p = "C:\Users\lenovo1\Dropbox\_Excel\pdf\Acrobat\" 'Folder to copy merged pdf to p2 = p


  10. #10
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    It is up to you to create the p2 folder or change the code to point to an existing path. I still don't know what path you want for p2. Making a new folder is trivial and not part of what you asked. MkDir() is one way to well make a directory, folder....

    Since I had set p2=p then that is likely why you had two merged copies there.

  11. #11
    Hi Ken

    Sorry no. In post 1 I was saying that once the files are merged, the merged files end up in a new folder (called mergedfiles for e.g.) So if you look at post 7 image, Folder 1PDF_1.pdf and Folder 2PDF_2.pdf should be in newly created folder for e.g. “mergedfiles”. So wondering whether p2 should be "C:\Users\test\Documents\Files\Merge Test\MergedFiles" ?

    I've added some screen shots of the desired output on a dummy test run and how things should look in the end. I hope this makes things clearer.


    Thanks for everything so far.
    Attached Images Attached Images
    Last edited by branston; 10-12-2019 at 04:42 AM.

  12. #12
    Set p2 = "C:\Users\test\Documents\files\Merge Test\MergedFiles"

    removed this piece of code

        'Merge pdfs in Parent folder, save copy there, and copy to p2 folder.
        'a = aFFs(p & "*.pdf")
        'If IsArray(a) Then
        '    ReDim Preserve f(UBound(f) - 1)
        '    j = j + 1
        '    pdf = p & "PDF_" & j & ".pdf"
            'If MergePDF(a, pdf) Then FileCopy pdf, p2 & "PDF_" & j & ".pdf"
        'End If
    


    and this piece of code below now merges the merged files which is not what is intended. I am thinking since there are now (new merged) pdf files in the MergedPDF folder, the code is merging the files inside this folder which is not what it is meant to do. Also there are no merged files in Folder1 and Folder2. These seem to be stored outside of Folder1 and Folder2. But should be like post11.

    MergedFilesPDF_3.pdf is actually the already merged Folder1PDF_1.pdf and Folder2PDF_2.pdf.
    In the 2nd screen shot PDF_3.pdf is actually the already merged files of PDF_1.pdf and PDF_2.pdf. This is not the desired output.


        'Merge pdfs in Subfolders, save merged file in subfolders,
            'and copy merged pdf to p2 folder.
        For i = 0 To UBound(f)
           a = aFFs(f(i) & "\*.pdf")
           If IsArray(a) Then
                j = j + 1
                pdf = f(i) & "PDF_" & j & ".pdf"
                If MergePDF(a, pdf) Then FileCopy pdf, p2 & "PDF_" & j & ".pdf"
            End If
        Next i
    
    Attached Images Attached Images
    Last edited by branston; 10-12-2019 at 06:56 AM.

  13. #13
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,645
    To
    - retrieve all PDF-files in Directory G:\OF and its subdirectories
    - to merge all pdf-files in every subdirectory into 1 merged PDF-file
    - to store the merged files into a directory that is not Directory G:\OF or one of its subdirectories:


    Sub M_snb()
        sn = Split(CreateObject("wscript.shell").exec("cmd /c dir ""G:\OF\*.pdf"" /b/s").stdout.readall, vbCrLf)
        
        For j = 1 To UBound(sn) - 1
           c00 = Left(sn(j), Len(sn(j)) - Len(Dir(sn(j))))
           If InStr(c01, vbLf & c00) = 0 Then c01 = c01 & vbLf & c00
        Next
        
        If c01 <> "" Then
           sp = Split(Mid(c01, 2), vbLf)
           For Each it In sp
              M_MergePDF Filter(sn, it), "G:\merged_" & Replace(it, "\", "_") & "pdf"
           Next
        End If
    End Sub
    Sub M_MergePDF(sn, c00)
      With CreateObject("AcroExch.PDDoc").Open(sn(0))
        For j = 1 To UBound(sn)
          Set pdf = CreateObject("AcroExch.PDDoc").Open(sn(j))
          .InsertPages .GetNumPages - 1, pdf, 0, pdf.GetNumPages, 0
          pdf.Close
        Next
    
        .Save 1, c00
        .Close
      End With
    
      Set pdf = Nothing
    End Sub

  14. #14
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    I guess you have to decide what you want and understand how the code can make it happen. There are many more considerations than what you have thought of I suspect. Due to the issues that I explain below, this is why you have what you have now. There is nothing really wrong. You just need some adjustments since there are many considerations. This should be the first part of any thread so that you get a solution that meets the goal(s).

    1. You must first answer is this a one time run or many runs? This is critical.

    2. If the p2 path is in the p (parent) path, code will need to skip merging pdfs in p2.
    a. If (1) is multiple runs, then one might: create a subfolder of parent named Run1, Run2, Run3, etc. Or, maybe, a merged folder that exists already but it would only contain the subfolders created during runtime called Run1, Run2, etc. with the (3) names.

    3. What file naming convention is used? e.g.
    a. Subfolder merged file to be called Merged.pdf.
    b. p2 copied Merged.pdf should be copied to p2 as subfolder's name dot pdf. e.g. SubFolder1.pdf
    i. If 3b is used, and another subfolder is called Subfolder1, how would code handle that?

    4. If (1) is multiple runs, then code must delete the previous merged file if one exists before merging in each subfolder.

    If you know that your subfolder names would never be duplicated, I would go with that method. So, rather than PDF_1.pdf, it would be maybe in SubFolder1\Merged.pdf and copy to p2 folder as p2\SubFolder1.pdf.

  15. #15
    Thanks Ken.

    I tried to keep my first post as succint and simple as possible. Maybe I've overlooked some considerations and that may be because I've assumed the task to be a simple one. ie. merge the files and move/copy/ the merged file into a new folder (which is in the same path).

    1.
    if I understand it correctly, currently I have 20 folders with 6 files each and the macro would run once to merge each of the 6 files in each of the 20 folders.
    2. yes p2 is in the p path so the code will have to skip merging pdfs in p2 (as they have already been merged)
    3a. folder1_.pdf, folder_2.pdf etc.
    4. If I understand this correctly (1) is a single run

    "
    If you know that your subfolder names would never be duplicated, I would go with that method. So, rather than PDF_1.pdf, it would be maybe in SubFolder1\Merged.pdf and copy to p2 folder as p2\SubFolder1.pdf.
    " That sounds sensible.

  16. #16
    Thanks snb.

    Type mismatch here in 2nd sub routine

          Set pdf = CreateObject("AcroExch.PDDoc").Open(sn(j))
    ??

  17. #17
    Just to add Ken

    If this piece of code is slightly amended to point to p instead of p2 (3rd line from bottom), then the output is nearly reached as there is no merging of the already merged files. Screen shot attached.

    Problem with it though is that Folder 1PDF_1.pdf and Folder 1PDF_1.pdf should inside the MergedFiles folder and PDF_1.pdf and PDF_2.pdf should be in the Folder 1 and Folder 2 folders respectively.

        'Merge pdfs in Subfolders, save merged file in subfolders,
            'and copy merged pdf to p2 folder.
        For i = 0 To UBound(f)
           a = aFFs(f(i) & "\*.pdf")
           If IsArray(a) Then
                j = j + 1
                pdf = f(i) & "PDF_" & j & ".pdf"
                If MergePDF(a, pdf) Then FileCopy pdf, p & "PDF_" & j & ".pdf"
           End If
        Next i
    

    Attached Images Attached Images
    • File Type: jpg p.jpg (19.3 KB, 49 views)

  18. #18
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    While it can be done, it is best to not save the merged pdf in the subfolders. If you do, then I would adopt the method that I explained and delete that file. That just adds more steps/code if you want it.

    I added the feature to create multiple Run folders called Run1, Run2, etc. You will need to manually create the parent folder. The code now skips that parent folder and all Run subfolders.

    While I do not have Acrobat on this computer, I left that method. I also left PDFCreator call code commented out. It works until the last file and then hangs for some reason in v3.0.

    To make it so that more can make use of this method, I added a pdftk method and function for that reason. I have not seen many concise code examples that create the inputs. There may be an option to merge all the pdfs in a folder. Some 3rd party applications have that feature. Using the routine that I made, it is limited in how many it can process due to the command line strings length. I have used pdfsam in a like manner in the past.

    Sub iSubfolders()    
        Dim a, f, i As Long, p As String
        Dim p2 As String, r As Strng, fso As Object
        
        'Parent folder
        p = ThisWorkbook.Path & "\"
        'p = "C:\Users\lenovo1\Dropbox\_Excel\pdf\Acrobat\"
        
        'Folder to copy merged pdfs in subfolders to, p2 initional, and r actual.
        p2 = p & "MergedPDFs"
        If Dir(p2, vbDirectory) = "" Then MkDir p2
        'Make a new folder in p2 to store this run's merged pdf files.
        Do
            i = i + 1
            r = p2 & "\Run" & i & "\"
            Loop Until Dir(r, vbDirectory) = ""
        MkDir r
        
        Set fso = CreateObject("Scripting.FileSystemObject")
        
        'SubFolders Array
        f = Split(CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
        """" & p & """" & " /ad/b/s").StdOut.ReadAll, vbCrLf)
        'Add parent folder to f:
        f(UBound(f)) = Left(p, Len(p) - 1)
        
        'Merge pdfs in subfolders, save merged file in r folder with subfolder's name.pdf.
        For i = 0 To UBound(f)
            a = aFiles(f(i) & "\", "*.pdf", False)
            If a(1) <> "" And InStr(f(i), p2) = 0 Then
                 MergePDF a, r & fso.GetFolder(f(i)).Name & ".pdf"  'Acrobat
                 'PDFCreatorCombine a, r & fso.GetFolder(f(i)).Name & ".pdf" 'PDFCreator
                'pdftkMerge a, r & fso.GetFolder(f(i)).Name & ".pdf"    'pdftk
            End If
        Next i
        Set fso = Nothing
        MsgBox "PDF files merged to folder: " & r
    End Sub
    'https://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/
    Sub pdftkMerge(arrayPDFs, pdfOut As String)
        Dim a, i As Long
        a = arrayPDFs
        For i = LBound(a) To UBound(a)
            a(i) = """" & a(i) & """"
        Next i
        'Command line options, https://www.pdflabs.com/docs/pdftk-man-page/
        '8191 character limit length for command line string.
        'Not sure what limit pdftk has, same probably.
        Shell "pdftk " & Join(a, " ") & " cat output " & """" & pdfOut & """", vbHide
    End Sub
    Last edited by Kenneth Hobs; 10-12-2019 at 03:23 PM.

  19. #19
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    For giggles, here is a pdfill version. Not sure if it was just my root folder p but it seemed to run better if I copied the pdf if there was just one in the subfolder. This method can merge by folder.

    Sub MergeToPDFill()    
        Dim a, f, i As Long, p As String
        Dim p2 As String, r As String, fso As Object
        Dim s As String, k As String
        
        'Parent folder
        p = ThisWorkbook.Path & "\"
        p = "C:\Users\lenovo1\Dropbox\_Excel\pdf\Acrobat\"
        
        'Folder to copy merged pdfs in subfolders to, p2 initional, and r actual.
        p2 = p & "MergedPDFs"
        If Dir(p2, vbDirectory) = "" Then MkDir p2
        'Make a new folder in p2 to store this run's merged pdf files.
        Do
            i = i + 1
            r = p2 & "\Run" & i & "\"
            Loop Until Dir(r, vbDirectory) = ""
        MkDir r
        
        Set fso = CreateObject("Scripting.FileSystemObject")
        
        'SubFolders Array
        f = Split(CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
        """" & p & """" & " /ad/b/s").StdOut.ReadAll, vbCrLf)
        'Add parent folder to f:
        f(UBound(f)) = Left(p, Len(p) - 1)
        'Debug.Print Join(f, vbCrLf), "done"
        
        'Merge pdfs in subfolders, save merged file in r folder with subfolder's name.pdf.
        For i = 0 To UBound(f)
            k = f(i) & "\" & Dir(f(i) & "\*.pdf")
            If InStr(f(i), p2 & "\") = 0 And Dir(f(i) & "\*.pdf") <> "" Then
                'Need 2 pdfs to merge or pdfill slows and may error
                If Dir <> "" Then  'at least 2 pdfs files exist
                    s = """" & "C:\Program Files (x86)\PlotSoft\PDFill\pdfill.exe" & """" & _
                        " MERGE " & _
                        """" & f(i) & "\" & """" & " " & _
                        """" & r & fso.GetFolder(f(i)).Name & ".pdf" & """"
                    Shell s, vbHide
                    Else
                    FileCopy k, (r & fso.GetFolder(f(i)).Name & ".pdf")
                End If
            End If
        Next i
        Set fso = Nothing
        MsgBox "PDF files merged to folder: " & r
    End Sub

  20. #20
    Hi Ken

    You're right the merged files in the subfolders are not essential as a copy of them will be placed in the new MergedPDFs folder anyway.

    Tried the above code but getting a Sub or Function not defined error for 'afiles' at

    a = aFiles(f(i) & "\", "*.pdf", False)
    
    But as far as I can tell it is defined ?????

    Thanks for all the help and pointers - it's a great help.

Posting Permissions

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