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.

Code:

---

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

---

To retrieve all PDF-files in folder "G:\OF" and its subfolders:

Code:

---

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

---

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.

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.

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.

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.

Code:

---

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

---

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?

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.

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)"

Code:

---

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

---

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.

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.

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

removed this piece of code

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.

Code:

---

    '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


---

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:

Code:

---

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

---

Code:

---

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

---

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.

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.

Thanks snb.

Type mismatch here in 2nd sub routine

Code:

---

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

---

??

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.

Code:

---

    '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


---

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.

Code:

---

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

---

Code:

---

'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

---

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.

Code:

---

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

---

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

Code:

---

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.

Code:

---

'Similar to: NateO's code, http://www.mrexcel.com/forum/showpost.php?p=1228168&postcount=2
Function aFiles(strDir As String, searchTerm As String, _
  Optional SubFolders As Boolean = True)
  Dim fso As Object
  Dim strName As String
  Dim i As Long
  ReDim strArr(1 To Rows.Count)
 
  'strDir must not have a trailing \ for subFolders=True
  If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
 
  'Exit if strDir does not exist
  If Dir(strDir, vbDirectory) = "" Then Exit Function
   
  Let strName = Dir$(strDir & searchTerm)
  Do While strName <> vbNullString
      Let i = i + 1
      Let strArr(i) = strDir & strName
      Let strName = Dir$()
  Loop
  Set fso = CreateObject("Scripting.FileSystemObject")
  'Strip trailing \ if subFolders=False
  If SubFolders = False Then strDir = Left(strDir, Len(strDir) - 1)
    Call recurseSubFolders(fso.GetFolder(strDir), strArr, i, searchTerm)
    Set fso = Nothing
    If i = 0 Then i = 1 'Returns one empty array element in strArr
    ReDim Preserve strArr(1 To i)
    aFiles = strArr
End Function


Private Sub recurseSubFolders(ByRef Folder As Object, _
    ByRef strArr, _
    ByRef i As Long, _
    ByRef searchTerm As String)
    Dim SubFolder As Object
    Dim strName As String
    For Each SubFolder In Folder.SubFolders
        Let strName = Dir$(SubFolder.Path & "\" & searchTerm)
        Do While strName <> vbNullString
            Let i = i + 1
            Let strArr(i) = SubFolder.Path & "\" & strName
            Let strName = Dir$()
        Loop
        recurseSubFolders SubFolder, strArr, i, searchTerm
    Next
End Sub

---

Quote:

---

Originally Posted by branston

Type mismatch here in 2nd sub routine

Code:

---

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

---

---

Why don't you give meaningful feedback ?
What is the value of sn(j) ?

SNB does concise code but it may be hard for some to see how it works.

After a run, Debug.Print's output can be viewed in VBE's Immediate Window. Change the parts in red to suit and view the results after a run.

The Replace() routine to make c00 for "it" needs a tweak as a colon is not a legal filename.

Code:

---

Sub M_snb()   
    sn = Split(CreateObject("wscript.shell").Exec("cmd /c dir ""C:\Users\lenovo1\Dropbox\_Excel\pdf\Acrobat\*.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_MergePDF1 Filter(sn, it), "C:\Users\lenovo1\Dropbox\_Excel\pdf\Acrobat\Merged\Run2\" & Replace(it, "\", "_") & "pdf"
      Next
    End If
End Sub


Sub M_MergePDF1(sn, c00)
  Debug.Print 0, sn(0)
    For j = 1 To UBound(sn)
      Debug.Print j, sn(j)
    Next
    Debug.Print "c00", c00
End Sub

---

branston, please see this FAQ about PMs. http://www.vbaexpress.com/forum/faq....aq_req_help_pm

Anything you have asked in PMs can be done in the thread. Then, anyone can answer it or maybe they had the same question(s).

Regarding the merged files slow to show up after the MsgBox(), that is due to the delay in processing code versus actual work being done in the background/hidden shell calls. I found that some 3rd party applications take longer to do their thing than others. PDFill was fast. Likely, Acrobat will be too but I don't have it on this computer to test. There are Shell and Wait routines one can use rather than Shell() if waiting for the shell process to end is really needed.

3rd party apps have some neat little options that one can play with. Acrobat can usually do those and sometimes more but sometimes not. The extra command line parameter options for the apps are easily used. To do the same in Acrobat takes some additional coding and sometimes extensive coding.

Here is an example that marry's both my methods and snb's for Acrobat. Like the other examples using other 3rd party applications, it is easily modified to call them rather than Acrobat as I demonstrated in this thread.

I left this one in test mode. Simply comment out the line and uncomment the mAcrobat call's line to do the actual merge in Acrobat.

Code:

---

Sub MergeToAcrobat()   
    Dim a, v, f, i As Long, p As String
    Dim p2 As String, r As String, fso As Object
    Dim s As String, s2 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 initially, 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")
   
    'All PDF files array
    f = Split(CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
    """" & p & "*.pdf" & """" & " /b/s").StdOut.ReadAll, vbCrLf)


    'Build string with folder names delimited by vbLF
    For i = 0 To UBound(f) - 1
      s = fso.GetParentFolderName(f(i)) & "\"
      If InStr(s2, vbLf & s) = 0 Then s2 = s2 & vbLf & s
    Next i


    If s2 <> "" Then
      a = Split(Mid(s2, 2), vbLf)  'Make array from s2 string but just elements with folder names.
      For Each v In a
            If InStr(v, p2) = 0 Then  'Process if folder v is not in p2, merged folder's path.
              k = fso.GetFolder(v).Name & ".pdf"
              mAcrobat1 Filter(f, v), r & k 'Test with output to VBE Immediate Window
              'mAcrobat Filter(f, v), r & k 'Perform the merge in Acrobat
            End If
      Next v
    End If
   
    Set fso = Nothing
End Sub


Sub mAcrobat(sn, c00)
    Dim j As Long, pdf As Object
   
    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 j
       
        .Save 1, c00
        .Close
    End With
   
    Set pdf = Nothing
End Sub


Sub mAcrobat1(sn, c00)
    Dim j As Long
    Debug.Print 0, sn(0)
    For j = 1 To UBound(sn)
        Debug.Print j, sn(j)
        Next
    Debug.Print "c00", c00
End Sub

---

Thanks Ken - and point taken.

will try the code but my point was actually about why the merged files are still being merged (into a new file with the parent folder.pdf as it’s name) once they are in the mergedPDFs folder. It’s an unnecessary file but I couldn’t work out where in the code this final step of merging the merged files was happening.

anyway will try the suggestions in your post.