PDA

View Full Version : [SOLVED] Merging PDFs Based on Checklist Selection in Excel



nreynolds
12-15-2014, 11:27 AM
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
12-15-2014, 01:55 PM
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
12-15-2014, 02:13 PM
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.

12620

Kenneth Hobs
12-16-2014, 08:02 AM
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
12-16-2014, 10:50 AM
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
12-16-2014, 02:13 PM
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
12-16-2014, 03:11 PM
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
12-16-2014, 03:14 PM
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
12-16-2014, 03:18 PM
You were indeed correct. Thanks for your help!

nreynolds
12-17-2014, 09:09 AM
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
12-17-2014, 10:18 AM
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
12-17-2014, 12:27 PM
Given the option, I would prefer to have the user be able to select a destination target...something like a browse function.

Kenneth Hobs
12-17-2014, 06:22 PM
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