5
\$\begingroup\$

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, " SomeWord.pdf")
    cnv = CellNameValue(0)
    ObjFileName() = Split(objFile2.Name, " AnotherWord 2014.pdf")
    ofn = ObjFileName(0)
    Files_to_Merge(1) = fld & "\" & ofn & " AnotherWord 2014.pdf"
    Files_to_Merge(0) = fld & "\" & cnv & " SomeWord.pdf"
    If StrComp(ofn, cnv) = 0 Then
    With oPDF

        TempBool = .Utility_Merge_PDF_Files(fld2 & "\" & ofn & " AnotherWord 2014.pdf", Files_to_Merge) 'The file merges here unless it generates an error and goes to If Not TempBool Then...

        If Not TempBool Then
            'MsgBox "An Error Occured: etc.
        Else
            'Optional
        End If
    End With
    End If
    i = i + 1
    Next objFile2
     i = i + 1
    Next objFile
    Set oPDF = Nothing
End Sub
\$\endgroup\$
3
  • 1
    \$\begingroup\$ I would use Dictionary Object to store all filenames of Folder1 then for each File in Folder2, check for Exists. If exists then merge them. \$\endgroup\$
    – PatricK
    Feb 3, 2015 at 3:44
  • \$\begingroup\$ @PatricK Hello Patrick, thank you for the suggestion. Could you please show how this code would look like? I looked at your link, but I would not know how to compare them and after that merge them. \$\endgroup\$ Feb 3, 2015 at 17:57
  • \$\begingroup\$ After reviewing your code carefully, Dictionary will not help. Instead I will use the .NET System.Collections.ArrayList will post code soon \$\endgroup\$
    – PatricK
    Feb 3, 2015 at 23:54

2 Answers 2

5
\$\begingroup\$

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
\$\endgroup\$
14
  • 1
    \$\begingroup\$ Welcome to Code Review! Are you using .Net's ArrayList in this code? I didn't realize you could do that. Feel free to drop by the VBA Chatroom sometime. \$\endgroup\$
    – RubberDuck
    Feb 4, 2015 at 2:05
  • \$\begingroup\$ @PatricK Thank you very much for the code. I am going to check it and let you know if it worrks or not, but the code looks very interesting. I already posted a reply yesterday, but for some reason it wasn't posted. Regards, Richard \$\endgroup\$ Feb 5, 2015 at 10:38
  • \$\begingroup\$ @PatricK Hi, I get a Run-timer error 13 Type Mismatch on this line: <pre><code>bSuccess = .Utility_Merge_PDF_Files(FDR2 & "\" & sFilePrefix & sAppend2, aFiles)</code></pre> bSuccess at that moment is False Any idea why that could be? Sorry I do not understand how to put code in like it should, I do not understand the help explanation. Richard \$\endgroup\$ Feb 5, 2015 at 20:37
  • \$\begingroup\$ I don't have documentation on using the .Utility_Merge_PDF_Files(), what are the input types? I am guessing it doesn't like aFiles. \$\endgroup\$
    – PatricK
    Feb 5, 2015 at 21:09
  • \$\begingroup\$ Try revised code, adopting what you used that works. What you get in the Immediate window? \$\endgroup\$
    – PatricK
    Feb 5, 2015 at 21:16
2
\$\begingroup\$

First off, let me say that I really like that you've documented what references your code requires. Nothing is more frustrating than trying to figure that out on your own when one is missing. Kudos.

Now I'll repeat something I've said often.

  1. Make it work.
  2. Make it right.
  3. Then, make it fast.

You've already made it work, we should make it right before trying to make it fast.

I recommend adding a reference to the Scripting library that you're using. You already have other references in your code. I don't see a reason not to early bind that one too. It gives you the advantage of intellisense and turns runtime errors (i.e. typos) into compile time errors.

The secondary benefit to doing this is it makes it easier to find FileSystemObject's FileExists method. The inner loop is completely unnecessary. This should make it a bit faster as we've removed a nested loop, but I think you're correct in thinking that the PDf merge is taking up most of the time.

Dim targetFilePath As String
For Each objFile In fld.Files
    CellNameValue() = Split(objFile.Name, " SomeWord.pdf")
    targetFilePath = "C:\MyFolder\PDF Merge\Merging Area\" & CellNameValue(0) & " AnotherWord 2014.pdf"

    If fs.FileExists(targetFilePath) Then
        'merge here
    End If

The third benefit is some code clarity. You may or may not realize it, but you're relying on the fact that the Folder object's default property is it's path.

    Files_to_Merge(1) = fld & "\" & ofn & " AnotherWord 2014.pdf"
    Files_to_Merge(0) = fld & "\" & cnv & " SomeWord.pdf"

I don't like relying on default properties when I can avoid it. It's better to be explicit. This would be more properly written as:

    Files_to_Merge(1) = fld.Path & "\" & ofn & " AnotherWord 2014.pdf"
    Files_to_Merge(0) = fld.Path & "\" & cnv & " SomeWord.pdf"

You don't need to early bind to do this, but it certainly makes it easier to find the property.

There are a few things I don't care for in the next snippet.

    With oPDF

        TempBool = .Utility_Merge_PDF_Files(fld2 & "\" & ofn & " AnotherWord 2014.pdf", Files_to_Merge) 'The file merges here unless it generates an error and goes to If Not TempBool Then...

        If Not TempBool Then
            'MsgBox "An Error Occured: etc.
        Else
            'Optional
        End If
    End With
  1. You're using a with block.... why? You've effectively added 2 lines of code and an additional 12 or so keystrokes. No reason to. Just make the call directly on oPDF.

    TempBool = oPDF.Utility_Merge_PDF_Files(fld2 & "\" & ofn & " AnotherWord 2014.pdf", Files_to_Merge)
    
  2. You're doing nothing with the result stored in TempBool. Either do something with it or remove the variable and If block. (TempBool is a pretty bad name by the way, if it stays, consider renaming it MergeResult.)

This is what I came up with. I couldn't test it, but it should be pretty close to what you need and easier to understand. I went ahead and just renamed all the variables to something meaningful.

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 fso As New FileSystemObject
    Dim sourceFolder As Folder
    Dim destinationFolder As Folder
    Dim sourceFile As File
    Dim oPDF As New PDF_reDirect_v25002.Batch_RC_AXD
    Dim Files_to_Merge(1) As String
    Dim CellNameValue() As String

    Set sourceFolder = fso.GetFolder("C:\MyFolder\PDF Merge\Merging Area")
    Set destinationFolder = fso.GetFolder("C:\MyFolder\PDF Merge\Merging Area\Merged")

    Dim targetFileName As String

    For Each sourceFile In fld.Files
        CellNameValue() = Split(objFile.Name, " SomeWord.pdf")
        targetFileName = CellNameValue(0) & " AnotherWord 2014.pdf"

        If fs.FileExists(fld.Path & targetFileName) Then
            Files_to_Merge(0) = sourceFile.Path
            Files_to_Merge(1) = targetFilePath

            oPDF.Utility_Merge_PDF_Files destinationFolder.Path & "\" & targetFileName
        End If

    Next 
    Set oPDF = Nothing
End Sub
\$\endgroup\$
7
  • 1
    \$\begingroup\$ Next sourceFile instead of Next objFile \$\endgroup\$
    – PatricK
    Feb 4, 2015 at 3:09
  • \$\begingroup\$ I have no idea what you're talking about @PatricK. =;)- \$\endgroup\$
    – RubberDuck
    Feb 4, 2015 at 3:10
  • \$\begingroup\$ Hello @RubberDuck Thank you very much for the code. I am going to test it and let you know if it worked. It looks a bit complicated, so have to do a good check. Sincerely, Richard \$\endgroup\$ Feb 4, 2015 at 21:44
  • \$\begingroup\$ You're welcome! It probably won't exactly work as is. Like I said, I couldn't test it, so it's possibly buggy. It should get you heading in the right direction though. \$\endgroup\$
    – RubberDuck
    Feb 4, 2015 at 23:50
  • 1
    \$\begingroup\$ Okay. My code was never intended to be production code @RHBerendsen. I have said several times that I couldn't test it and it was likely to be buggy. The idea of a code review isn't to hand you working code on a platter. It's to provide insight into how you can make your code better. If you get working code from a reviewer, it should be considered a bonus, not a requirement. \$\endgroup\$
    – RubberDuck
    Feb 5, 2015 at 21:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.