Finding matching PDF files in different folders and merging the two files into one

I have code which currently loops through one folder, finds two matching pdf-filenames and merges them into 1 pdf-file always in the same order. File 1 then File 2. My code is slow, maybe because merging PDF files takes a long time, but also because it has to search one folder and match filenames. Before I searched through two folders, but that took too long. I do not want to write the filenames to an Excel-file and then match, but I want to merge the PDF files immediately when VBA finds a match. I found some code and adjusted it to my needs and put some new things into it.

I have seen a lot of code using Acrobat or Pdftk, but I do not have Acrobat and Pdftk does not work with me even though I do exactly what is written on several sites. For some reason Pdftk does not merge my files.

My code matches filenames based on the first part of the filename, before the AnotherWord 2014.pdf or before SomeWord.pdf.

• Example document name1: John Doe SomeWord.pdf

• Example document name2: John Doe AnotherWord 2014.pdf

Please look at this code and please post code which will do the same thing, only much faster. My code isn't the best, but it works. I use PDF reDirect Pro v2.5.2 (freeware) and a reference to the program.

```
Sub MergePDF_Files()
'Only works with PDF reDirect Pro v2.5.2
'And needs to have a reference to PDF_reDirect_v2500 and PDF reDirect Pro Remote Control
Dim fs As Object
Dim fld As Object
Dim fld2 As Object
Dim objFile As Object
Dim objFile2 As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Dim oPDF As New PDF_reDirect_v25002.Batch_RC_AXD
Dim TempBool As Boolean
Dim Files_to_Merge(1) As String
Dim ObjFileName() As String
Dim CellNameValue() As String
Dim ofn As String
Dim cnv As String
Dim i As Integer

Set fld = fs.GetFolder("C:\MyFolder\PDF Merge\Merging Area")
Set fld2 = fs.GetFolder("C:\MyFolder\PDF Merge\Merging Area\Merged")
i = 1

For Each objFile In fld.files
For Each objFile2 In fld.files
CellNameValue() = Split(objFile.Name, " So

I cannot do full test as I do not have that PDF software of yours. But the idea is that process all file names in that folder 1, store them in a collection, also if the file name ends with " SomeWord.pdf" then add to another collection.

When done, process the other collection and see if a matched " AnotherWord 2014.pdf" found in first collection. Merge if found.

Reworked after Trial is downloaded.

Option Explicit

Private oFullList As Object, oMyList As Object, oFSO As Object

Private Const FDR1 = "C:\Test\"
Private Const FDR2 = "C:\Test\Merged\"

Private Const sAppend1 = " SomeWord.pdf"
Private Const sAppend2 = " AnotherWord 2014.pdf"

Private oPDF As New PDF_reDirect_v25002.Batch_RC_AXD
Private lFiles As Long

Sub Main()
    lFiles = 0
    Debug.Print Now & vbTab & "Program Started"
    '===[ Create Collection Objects ]===
    ' FullList stores all the filenames in the directory
    If oFullList Is Nothing Then
        Set oFullList = CreateObject("System.Collections.ArrayList") ' Create if not created
    Else
        oFullList.Clear ' Remove all old entries
    End If
    ' MyList only stores filenames that will be checked for merge
    If oMyList Is Nothing Then
        Set oMyList = CreateObject("System.Collections.ArrayList") ' Create if not created
    Else
        oMyList.Clear
    End If
    '===[ Check FileSystemObject ]===
    If oFSO Is Nothing Then
        Set oFSO = CreateObject("Scripting.FileSystemObject")
    End If
    '===[ Main procedures ]===
    CheckFiles
    'ListFiles ' Skipped, debug only
    ProcessMergeFiles
    '===[ Clean Up ]===
    Set oFullList = Nothing
    Set oMyList = Nothing
    Set oFSO = Nothing
    Set oPDF = Nothing
    '===[ Print Summary ]===
    Debug.Print Now & vbTab & "Program Finished. " & lFiles & " merged PDFs has been created"
End Sub

Private Sub CheckFiles()
    Dim oFDR As Object, oFile As Object, sTmp As String, n As Long
    '===[ Process all filenames of FDR1 ]===
    For Each oFile In oFSO.GetFolder(FDR1).Files
        sTmp = oFile.Name
        ' Add to FullList collection
        oFullList.Add sTmp
        ' Only add to MyList collection if it ends with sAppend1
        n = InStr(1, sTmp, sAppend1, vbTextCompare)
        If n > 0 Then
            oMyList.Add Left(sTmp, n - 1) ' Stores only the prefix
        End If
    Next
End Sub

Private Sub ListFiles()
    Dim i As Long
    Debug.Print "=== Listing " & oMyList.Count & " item(s) in oMyList ==="
    For i = 0 To oMyList.Count - 1
        Debug.Print i + 1 & vbTab & oMyList(i)
    Next
End Sub

Private Sub ProcessMergeFiles()
    Dim i As Long, sTmp As String
    For i = 0 To oMyList.Count - 1
        sTmp = oMyList(i)
        If oFullList.Contains(sTmp & sAppend2) Then
            'Debug.Print "Merge file pair found: """ & sTmp & """"
            MergeFiles sTmp
        End If
    Next
End Sub

Private Sub MergeFiles(sFilePrefix As String)
    Dim bSuccess As Boolean
    Dim aFiles() As String ' <- Required datatype

    If oPDF Is Nothing Then
        Set oPDF = New PDF_reDirect_v25002.Batch_RC_AXD
    End If

    ReDim aFiles(1)
    aFiles(0) = FDR1 & sFilePrefix & sAppend1
    aFiles(1) = FDR1 & sFilePrefix & sAppend2

    With oPDF
        bSuccess = .Utility_Merge_PDF_Files(FDR2 & "\" & sFilePrefix & sAppend2, aFiles)
        If bSuccess Then
            Debug.Print "Merged pdf files with prefix """ & sFilePrefix & """"
            lFiles = lFiles + 1
        Else
            Debug.Print "Failed to merge pdf files with prefix " & sFilePrefix
            Debug.Print "ERR(" & .LastErrorNumber & "):" & .LastErrorDescription
            .Reset_Errors
        End If
    End With
End Sub

StackExchange Code Review Q#79465, answer score: 5