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

[branston]

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

[snb]

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

[branston]

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.

[snb]

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.

[branston]

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.

[Kenneth Hobs]

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

[branston]

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?

[Kenneth Hobs]

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.

[branston]

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

[Kenneth Hobs]

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.

[branston]

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.

[branston]

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

[snb]

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

[Kenneth Hobs]

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.

[branston]

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.

[branston]

Thanks snb.

Type mismatch here in 2nd sub routine



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


??

[branston]

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

[Kenneth Hobs]

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

[Kenneth Hobs]

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

[branston]

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.

[Kenneth Hobs]

'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

[snb]

Type mismatch here in 2nd sub routine


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


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

[Kenneth Hobs]

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.


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

[Kenneth Hobs]

branston, please see this FAQ about PMs. http://www.vbaexpress.com/forum/faq.php?faq=psting_faq_item#faq_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.


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

[branston]

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.