# VBA to Browse for Folder  and Merge Files - PDF



## damaniam1604 (Oct 30, 2018)

The call of this macro seems easier to explain than tolocate online. I'm rather green in VBA, so any related items I have foundlooked like Greek to me. Any assistance is greatly appreciated.

The call of the Macro: 



Open Shell App to allow me to browse for afolder on my computer


Select desired folder via shell app


Combine all .pdf files in the desired folderinto a single .pdf


Save newly created .pdf in the desired folder


Name of the newly created .pdf is in A1

P.S.: I am currently using Office 365 for excel and Adobe AcrobatPro DC


----------



## damaniam1604 (Oct 31, 2018)

I was able tofind the code below, but I am using Acrobat Pro DC. So I am unsure if I enabledthe correct reference.

Source: post #4  of 
[URL}http://www.vbaexpress.com/forum/showthread.php?47310-Need-code-to-merge-PDF-files-in-a-folder-using-adobe-acrobat-X[/URL]



```
[FONT=Calibri][SIZE=3][COLOR=#000000]Sub Main()[/COLOR][/SIZE][/FONT][FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Const DestFile As String ="MergedFile.pdf" ' <-- change to suit[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Dim MyPath As String, MyFilesAs String[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Dim a() As String, i As Long,f As String[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]     ' Choose the folder or justreplace that part by: MyPath = Range("E3")[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    WithApplication.FileDialog(msoFileDialogFolderPicker)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]         '.InitialFileName ="C:\Temp\"[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        .AllowMultiSelect = False[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        If .Show = False ThenExit Sub[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MyPath =.SelectedItems(1)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        DoEvents[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End With[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]      ' Populate the array a() byPDF file names[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If Right(MyPath, 1) <>"\" Then MyPath = MyPath & "\"[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ReDim a(1 To 2 ^ 14)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    f = Dir(MyPath &"*.pdf")[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    While Len(f)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        If StrComp(f, DestFile,vbTextCompare) Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            i = i + 1[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            a(i) = f[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        f = Dir()[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Wend[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ' Merge PDFs[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If i Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        ReDim Preserve a(1 To i)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MyFiles = Join(a,",")[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Application.StatusBar ="Merging, please wait ..."[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Call MergePDFs(MyPath,MyFiles, DestFile)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Application.StatusBar =False[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Else[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox "No PDF filesfound in" & vbLf & MyPath, vbExclamation, "Canceled"[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End If[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile AsString = "MergedFile.pdf")[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]' ZVI:2013-08-27http://www.vbaexpress.com/forum/showthread.php?47310-Need-code-to-merge-PDF-files-in-a-folder-using-adobe-acrobat-X[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]' Reference required: VBE - Tools - References - Acrobat[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Dim a As Variant, i As Long,n As Long, ni As Long, p As String[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Dim AcroApp As NewAcrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If Right(MyPath, 1) ="\" Then p = MyPath Else p = MyPath & "\"[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    a = Split(MyFiles,",")[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ReDim PartDocs(0 ToUBound(a))[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    On Error GoTo exit_[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If Len(Dir(p & DestFile))Then Kill p & DestFile[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    For i = 0 To UBound(a)[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        ' Check PDF file presence[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        If Dir(p &Trim(a(i))) = "" Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            MsgBox "File notfound" & vbLf & p & a(i), vbExclamation, "Canceled"[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Exit For[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        ' Open PDF document[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Set PartDocs(i) =CreateObject("AcroExch.PDDoc")[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        PartDocs(i).Open p &Trim(a(i))[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        If i Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            ' Merge PDF toPartDocs(0) document[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            ni =PartDocs(i).GetNumPages()[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            If NotPartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                MsgBox"Cannot insert pages of" & vbLf & p & a(i),vbExclamation, "Canceled"[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            End If[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            ' Calc the number ofpages in the merged document[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            n = n + ni[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            ' Release the memory[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            PartDocs(i).Close[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Set PartDocs(i) =Nothing[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Else[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            ' Calc the number ofpages in PartDocs(0) document[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            n =PartDocs(0).GetNumPages()[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Next[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If i > UBound(a) Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        ' Save the mergeddocument to DestFile[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        If NotPartDocs(0).Save(PDSaveFull, p & DestFile) Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            MsgBox "Cannotsave the resulting document" & vbLf & p & DestFile,vbExclamation, "Canceled"[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End If[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]exit_:[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ' Inform about error/success[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If Err Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox Err.Description,vbCritical, "Error #" & Err.Number[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ElseIf i > UBound(a) Then[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox "Theresulting file is created:" & vbLf & p & DestFile,vbInformation, "Done"[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End If[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ' Release the memory[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If Not PartDocs(0) Is NothingThen PartDocs(0).Close[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set PartDocs(0) = Nothing[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ' Quit Acrobat application[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    AcroApp.Exit[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set AcroApp = Nothing[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]

[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
```


----------



## John_w (Oct 31, 2018)

The Reference required is Adobe Acrobat nn.0 Type Libary, where nn.0 is your version of Acrobat Pro.

More code at https://www.mrexcel.com/forum/excel...ted-existing-pdf-post5159258.html#post5159258 which could be adapted for your requirement.

Change the FileDialog(msoFileDialogOpen) to FileDialog(msoFileDialogFolderPicker) and use a Dir function loop instead of the For Next loop.


----------



## damaniam1604 (Nov 2, 2018)

I believe I located the correct reference for Adobe Acrobat Pro DC, but I'm getting an error. I'm not sure what portion or line of the code is causing it. The error is a dialog box titled Canceled. The error is "File not found C:\files\test1\September 2018\test1". When I used the browser to locate my desired file contain the pdfs, I selected September 2018. Which is where the pdfs files are locate. Advice?


----------



## ZVI (Nov 2, 2018)

damaniam1604 said:


> I believe I located the correct reference for Adobe Acrobat Pro DC, but I'm getting an error. I'm not sure what portion or line of the code is causing it. The error is a dialog box titled Canceled. The error is "File not found C:\files\test1\September 2018\*test1*". When I used the browser to locate my desired file contain the pdfs, I selected September 2018. Which is where the pdfs files are locate. Advice?


Hi,
Please confirm the file name in error message is *test1.PDF* but not *test1* without file extension.
In Sub MergePDF try replacing this line of the code: If Dir(p & *Trim(*a(i)*)*) = "" Then
by that one without Trim(): If Dir(p & a(i)) = "" Then


----------



## damaniam1604 (Nov 6, 2018)

@ZVI

Thanks for your help. To answer your question, the window does not include the file extension. Also, when I browse  to the folder containing the targeted pdf's I don' see any files in the folder. Your assistance is always appreciated.


----------



## damaniam1604 (Nov 7, 2018)

As I said in my previous reply, the error does not include the file extension. With the error being the way it is, C:\Folder\subfolder\Folder, I am inclined to believe the error is related to the section in "MergePDFs” of "If Right (MyPath,1)=""…) I say that because the value in the error relating to a(i) shouldn't return "subfolder\Folder" in the error dialog. 

Also, to some degree it would seem that if the file or folder or subfolder name includes a comma, then it effects the execution of the macro. 

Once we figured the error out, I'd like to have my resulting combined pdf file name to be based upon the browsed to folder. Ultimately the pdfs are located in D:\...Company A, LLC\Month Year and I would like to use the company name and the month and year to give the combined file a name in the format of Company A, LLC - Month Year - Financial Statement. Thanks for all your assistance.


----------



## ZVI (Nov 7, 2018)

damaniam1604 said:


> ... the window does not include the file extension...


Try this:

```
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
            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, ",")
        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
 
    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
        If Dir(p & a(i)) = "" Then ' <-- ZVI:2018-11-08 Without Trim()
            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 & 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"
            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
```


----------



## ZVI (Nov 7, 2018)

damaniam1604 said:


> ... I'd like to have my resulting combined pdf file name to be based upon the browsed to folder. Ultimately the pdfs are located in D:\...Company A, LLC\Month Year and I would like to use the company name and the month and year to give the combined file a name in the format of Company A, LLC - Month Year - Financial Statement.


Below is version where name of the destination file (DestFile) is built by joining names of 2 last folders in the selected path with "Financial Statement.pdf" at the end.

```
Sub Main()
 
  Dim DestFile As String  ' <-- ZVI:2018-11-08
 
  Dim MyPath As String, MyFiles As String
  Dim a() As String, i As Long, f As String, Arr
 
  ' 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 & "\"
 
  '--> 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, ",")
    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 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, ",")
  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"
      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"
      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
```


----------



## damaniam1604 (Nov 8, 2018)

Unfortunately, I am still getting the same error. I think abit more detail might be helpful.
So, when the file picker opens, I browse toD:\Dropbox\User\All Entities\Financials\Company A, LLC\September 2018\. Isingle click on the September 2018 folder, though single or double doesn’t seemto matter. Then click ok. Then I received the error, “File not found D:\Dropbox\User\All Entities\Financials\CompanyA, LLC\September 2018\Company A”. To me there are a couple of odd things goingon here. One, is that the error is occurring when the September 2018 filecontains several pdfs. Secondly, the error itself ends in “\Company A”. The Macrois not only reporting an incorrect error, but in the error message itself adds the Companyname, less “, LLC”, to the end of the notification. I can’t think of a cause. 



Also, to confirm that I am not in error, regarding thereferences. Currently I have the following References enabled. Visual Basic ForApplications, Microsoft Excel 16.0 Object Library, Microsoft Office 16.0 ObjectLibrary, Solver, and Adobe Acrobat 10.0 Type Library. The Adobe library filewas link via the “Browse…” option and the file was located in C:\Program Files(x86)\Adobe\Acrobat DC\Acrobat\acrobat.tlb.

I can’t thank you enough for all of your assistance.


----------



## damaniam1604 (Oct 30, 2018)

The call of this macro seems easier to explain than tolocate online. I'm rather green in VBA, so any related items I have foundlooked like Greek to me. Any assistance is greatly appreciated.

The call of the Macro: 



Open Shell App to allow me to browse for afolder on my computer


Select desired folder via shell app


Combine all .pdf files in the desired folderinto a single .pdf


Save newly created .pdf in the desired folder


Name of the newly created .pdf is in A1

P.S.: I am currently using Office 365 for excel and Adobe AcrobatPro DC


----------



## ZVI (Nov 9, 2018)

Hi, my bad - two misprints were fixed now, the code below passed testing succesfully:

```
Sub Main()
 
  Dim DestFile As String  ' <-- ZVI:2018-11-08
 
  Dim MyPath As String, MyFiles As String
  Dim a() As String, i As Long, f As String, Arr
 
  ' Choose the folder or just replace that part by: MyPath = Range("E3")
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "D:\Dropbox\User\All Entities\Financials\"
    .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, ",")
    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 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.AcroPDDoc
 
  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 & a(i)) = "" Then        ' <-- ZVI:2018-11-08 Without Trim()
      MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled"
      Exit For
    End If
    ' Open PDF document
    Set PartDocs(i) = New Acrobat.AcroPDDoc
    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"
      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
```


----------



## damaniam1604 (Nov 19, 2018)

ZVI,
I can’tthank you enough for all of your help. I still run in to the same error frombefore. I found the below bit of code at the link below. Using the Acrobat.tlbreference this macro works perfectly. 
Based onthis, it would seem that the error comes from either browsing to the foldercontaining the multiple pdf files or with creating the array of names and pagenumbers. Obviously, the code below won’t work for my needs since it doesn’thave the browse to folder functionality and nor do my files have known names.

If you couldlook over this and give me some advice, I would appreciate it.
http://khkonsulting.com/2009/03/adobe-acrobat-and-vba-an-introduction/


```
[FONT=Calibri][SIZE=3][COLOR=#000000]    Dim AcroApp As Acrobat.CAcroApp[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    Dim Part1Document As Acrobat.CAcroPDDoc[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Dim Part2Document As Acrobat.CAcroPDDoc[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    Dim numPages As Integer[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    Set AcroApp =CreateObject("AcroExch.App")[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    Set Part1Document =CreateObject("AcroExch.PDDoc")[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set Part2Document =CreateObject("AcroExch.PDDoc")[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    Part1Document.Open("C:\temp\Part1.pdf")[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Part2Document.Open("C:\temp\Part2.pdf")[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    ' Insert the pages of Part2 after the endof Part1[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    numPages = Part1Document.GetNumPages()[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    If Part1Document.InsertPages(numPages - 1,Part2Document,[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                                0,Part2Document.GetNumPages(), True) = False Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox "Cannot insert pages"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End If[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    If Part1Document.Save(PDSaveFull,"C:\temp\MergedFile.pdf") = False Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox "Cannot save the modifieddocument"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End If[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    Part1Document.Close[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Part2Document.Close[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    AcroApp.Exit[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set AcroApp = Nothing[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set Part1Document = Nothing[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set Part2Document = Nothing[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]    MsgBox "Done"[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub [/COLOR][/SIZE][/FONT]
```


----------



## ZVI (Dec 19, 2018)

Hi,
To your PM - for me the reason of the problem is not in the file picker dialog.
Seems comma is used in file name of some your PDFs, but Split with comma separator has been used in the code.
Try this modification:

```
Sub Main()
 
  Dim DestFile As String  ' <-- ZVI:2018-11-08
 
  Dim MyPath As String, MyFiles As String
  Dim a() As String, i As Long, f As String, Arr
 
  ' Choose the folder or just replace that part by: MyPath = Range("E3")
  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 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 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
```


----------



## damaniam1604 (Dec 19, 2018)

ZVI, I bow to your excel prowess. Works like a charm. Thanks for everything.


----------



## ZVI (Dec 19, 2018)

You are welcome! Glad we got it all sorted.


----------

