Merging PDFs Based on Checklist Selection in Excel

[nreynolds]

I'm in need of some VBA coding that will merge a number of pdf's that are found in a single folder. Additionally, I only want to merge pdfs that have been selected via a checklist in Excel. I currently have the checklist returning values of either 0 (False) or 1 (True) in a column. I've implemented the coding found in Thread 47310 but haven't yet succesfully figured out how to get it to do what I'm looking for. I'm fairly new at VBA so any help is appreciated. Let me know if you need additional information.

[Kenneth Hobs]

Try posting a short example file. It will help us help you better. Just a short 3 or 4 list of checkboxes and the data cells is enough.

Using the reference thread, a few additions to submit to the routine in post #4 should suffice. Another method is to use a 3rd party program and send the correct input command line parameters.

In this thread, I explained how to get the vb.net file that I made to do that and more.

Referenced Thread:
http://www.vbaexpress.com/forum/showthread.php?47310

[nreynolds]

Kenneth,

Attached is my worksheet that I'm using as a checklist. As you can tell, each selection yields either a "True" or False" return. Eventually the checklist will include quite a few more options, but I thought I'd try to keep it simpler for now. I would imagine there is a way to apply some conditional formating to the merge code previously developed to only merge the sheets with a "True" result. I would alos think that this would be dependent on the pdf's being defined in the coding in the same order as the the checklist. Again, referencing the previously developed coding, I'm currently loading the pdfs by file name and in the same order as the checklist.

Thanks for your help.

Drawing Checklist.xlsx

[Kenneth Hobs]

There are several ways to build the string of filenames to merge. If there would never be duplicates that you wanted to keep, then a dictionary or collection method would be best. String concatenation can be used but an array would be a bit more efficient if the dictionary method is not suitable.

Since I did not see any filenames in your checkbox controls or near them, I am guessing that the filename would be maybe the checkboxes alternative text? e.g. Product 15. One might then set the macro the full path and filename such as c:\products\Product 15.pdf. Of course the merged filename could be c:\products\SelectedProducts.pdf or such.

The routine in the reference thread stops if a file that was passed does not exist. So, one probably wants to build the string of filenames to merge but check if the file exists first.

Of course you really don't need the True/False or 0/1 columns.

Another approach you may want to consider later is to use a listbox or combobox control in a Userform. They can be set to show checkboxes next to each item.

I will finish my example by tonight.

[nreynolds]

Kenneth,

Thanks for taking a look at this. The reason I'm using the checklist format in excel is that this will be part of a larger workbook that will be set up as design tool for a water pipeline and storage tank. In addition to performing the design, I'd like the workbook to be able to generate a set of drawings based upon the user's selection. There will be other functions of the workbook that will create an entire design package. At least that is my ultimate end goal...still a lot of development to be done but this "PDF Merge" is a big part of it.

[Kenneth Hobs]

Here is the array method. Adobe Acrobat and not Adobe Reader is required for the referenced link's object.

Private Sub CommandButton1_Click()  Dim i As Integer, j As Integer, s As String, a() As Variant
  Dim pdfDirSource As String, pdfSource As String, pdfTarget As String
  
  pdfDirSource = "x:\pdf\Drawings\"  'Use trailig backslash
  pdfTarget = "Drawings.pdf"
  
  If Len(Dir(pdfDirSource, vbDirectory)) = 0 Then
    MsgBox pdfDirSource & vbLf & vbLf & "Macro is ending.", vbCritical, "Path Does Not Exist"
    Exit Sub
  End If
  
  j = 1
  ReDim a(1 To 1)
  a(1) = ""
  For i = 1 To 13
    With ActiveSheet
      If .CheckBoxes("Check Box " & i).Value = 1 Then
        s = .Shapes("Check Box " & i).AlternativeText & ".pdf"
        pdfSource = pdfDirSource & s
        If Dir(pdfSource) <> "" Then
          ReDim Preserve a(1 To j)
          a(j) = s
          j = j + 1
        End If
      End If
    End With
  Next i


  'Merge the pdfs
  If a(1) <> "" Then
    MergePDFs pdfDirSource, Join(a, ","), pdfTarget
    'Show the merged pdf
    Shell "cmd /c " & pdfDirSource & pdfTarget
  End If
End Sub

[nreynolds]

Kenneth,

The code is working brilliantly! I really appreciate it. The only issue I seem to be having is the code is not recognizing if I select the first option as shown on my previously attached worksheet: "Above Ground Fiberglass Cistern". If I select this item alone and attempt to run the macro, nothing happens...not even the "File Not Found" message you included in the coding. If I select it along with other options, only the other options are merged in the resulting pdfs. Any suggestions? Both subs are shown below for your reference.

Private Sub CommandButton1_Click()
  Dim i As Integer, j As Integer, s As String, a() As Variant
  Dim pdfDirSource As String, pdfSource As String, pdfTarget As String
  
  pdfDirSource = "S:\Service_Center\NRCS\ENG\Nick\ND_STOCKTANKS_PDF\"  'Use trailing backslash
  pdfTarget = "Drawings.pdf"
  
  If Len(Dir(pdfDirSource, vbDirectory)) = 0 Then
    MsgBox pdfDirSource & vbLf & vbLf & "Macro is ending.", vbCritical, "Path Does Not Exist"
    Exit Sub
  End If
  
  j = 1
  ReDim a(1 To 1)
  a(1) = ""
  For i = 1 To 13
    With ActiveSheet
      If .CheckBoxes("Check Box " & i).Value = 1 Then
        s = .Shapes("Check Box " & i).AlternativeText & ".pdf"
        pdfSource = pdfDirSource & s
        If Dir(pdfSource) <> "" Then
          ReDim Preserve a(1 To j)
          a(j) = s
          j = j + 1
        End If
      End If
    End With
  Next i

  'Merge the pdfs
  If a(1) <> "" Then
    MergePDFs pdfDirSource, Join(a, ","), pdfTarget
    'Show the merged pdf
    Shell "cmd /c " & pdfDirSource & pdfTarget
  End If
End Sub
Sub MergePDFs(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")
' ZVI:2013-08-27
' 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
            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
 
    ' Quit Acrobat application
    AcroApp.Exit
    Set AcroApp = Nothing
 
End Sub

[Kenneth Hobs]

Check your spelling in the Alternative Text. I noticed that and made my PDF filename the same. Yet another reason why I like example files to test.

[nreynolds]

You were indeed correct. Thanks for your help!

[nreynolds]

Kenneth,

One other request regarding this macro: I'd like to save the resulting pdf on the computer's desktop rather than in the folder where the singular pdfs are stored. Any suggestions?

[Kenneth Hobs]

Getting that folder name is easy enough.

The work needed though is to modify the referenced routine. One can either hard code it for your use or add an optional parameter to allow setting a different target name with a different path. One could also modify the reference routine to look at the DestFile input string and if it had a "\" character, to use that rather than building it from the MyPath string. What is your preference?

[nreynolds]

Given the option, I would prefer to have the user be able to select a destination target...something like a browse function.

[Kenneth Hobs]

I can't test this right now.

In the sheet's code:

Private Sub CommandButton1_Click()  Dim i As Integer, j As Integer, s As String, a() As Variant
  Dim pdfDirSource As String, pdfSource As String, pdfTarget As String
  
  pdfDirSource = ThisWorkbook.Path & "\"  'Use trailig backslash
  pdfTarget = "Drawings.pdf"
  
  If Len(Dir(pdfDirSource, vbDirectory)) = 0 Then
    MsgBox pdfDirSource & vbLf & vbLf & "Macro is ending.", vbCritical, "Path Does Not Exist"
    Exit Sub
  End If
  
  j = 1
  ReDim a(1 To 1)
  a(1) = ""
  For i = 1 To 13
    With ActiveSheet
      If .CheckBoxes("Check Box " & i).Value = 1 Then
        s = .Shapes("Check Box " & i).AlternativeText & ".pdf"
        pdfSource = pdfDirSource & s
        If Dir(pdfSource) <> "" Then
          ReDim Preserve a(1 To j)
          a(j) = s
          j = j + 1
        End If
      End If
    End With
  Next i


  'Merge the pdfs
  If a(1) <> "" Then
    s = GetFolder("Merge Folder", CreateObject("WScript.Shell").SpecialFolders("Desktop"))
    s = s & "Merged.pdf"
    Debug.Print s
    MergePDFs pdfDirSource, Join(a, ","), s
    'Show the merged pdf
    'Shell "cmd /c " & s
  End If
End Sub

In a Module:

Function GetFolder(Optional sTitle As String = "Select Folder", _  Optional sInitialFilename As String)
  Dim myFolder As String
  With Application.FileDialog(msoFileDialogFolderPicker)
    If sInitialFilename = "" Then sInitialFilename = ThisWorkbook.Path


    .initialFilename = sInitialFilename
    .Title = sTitle
    If .Show = -1 Then
      GetFolder = .SelectedItems(1)
      If Right(GetFolder, 1) <> "\" Then
            GetFolder = GetFolder & "\"
      End If
      Else: GetFolder = ""
    End If
  End With
End Function


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
 
    ' Adjust MyPath string if needed.
    If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"
    a = Split(MyFiles, ",")
    ReDim PartDocs(0 To UBound(a))
    
    ' Save to MyPath folder if target folder for merged PDF file was not input. (ken)
    If InStr(DestFile, "\") = 0 Then DestFile = p & DestFile
 
    On Error GoTo exit_
    If Len(Dir(DestFile)) Then Kill 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, DestFile) Then
            MsgBox "Cannot save the resulting document" & vbLf & 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