0 votes
in VBA by Beginner (5 points)

I am creating around 300 PDFs in an Access app that I am then combining into one large PDF using the MergePDFs function which worked beautifully. Thanks!

I used the LoopThroughFilesInFolder function to load an array to contain the filenames as input to the MergePDFs function.

Is there a way to cause each filename to become a bookmark in the resulting combined PDF?

Thank you for any assistance you can provide.

1 Answer

+1 vote
by Skilled (670 points)
selected by
 
Best answer

Your question is similar to this MrExcel article. Here is a modified version of MergePDFs with new code demarcated by comments with slash characters:

Private Function MergePDFs(arrFiles() As String, strSaveAs As String) As Boolean
'---------------------------------------------------------------------------------------------------
'---PROGRAM: MergePDFs------------------------------------------------------------------------------
'---DEVELOPER: Ryan Wells (wellsr.com)--------------------------------------------------------------
'---DATE: 09/2017-----------------------------------------------------------------------------------
'---DESCRIPTION: This function uses Adobe Acrobat (won't work with just the Reader!) to-------------
'--- combine PDFs into one PDF and save the new PDF with its own file name.-------------
'---INPUT: The function requires two arguments.-----------------------------------------------------
'--- 1) arrFiles is an array of strings containing the full path to each PDF you want to------
'--- combine in the order you want them combined.------------------------------------------
'--- 2) strSaveAs is a string containing the full path you want to save the new PDF as.-------
'---REQUIREMENTS: 1) Must add a reference to "Adobe Acrobat X.0 Type Library" or "Acrobat"----------
'--- under Tools > References. This has been tested with Acrobat 6.0 and 10.0.------
'---CAUTION: This function won't work unless you have the full Adobe Acrobat. In other words,-------
' Adobe Reader will not work.------------------------------------------------------------
'---------------------------------------------------------------------------------------------------
 
Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
Dim i As Integer
Dim iFailed As Integer
On Error GoTo NoAcrobat:
'Initialize the Acrobat objects
Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
'Open Destination, all other documents will be added to this and saved with a new filename
objCAcroPDDocDestination.Open (arrFiles(LBound(arrFiles))) 'open the first file
'//////////
Dim nBookMark As Long, nPage As Long, BookMarkRoot As Object
Set BookMarkRoot = objCAcroPDDocDestination.GetJSObject.BookMarkRoot
i = LBound(arrFiles)
nPage = 0
nBookMark = 1
BookMarkRoot.createchild arrFiles(i), "this.pageNum=" & nPage, nBookMark
'\\\\\\\\\\
'Open each subsequent PDF that you want to add to the original
  'Open the source document that will be added to the destination
    For i = LBound(arrFiles) + 1 To UBound(arrFiles)
        objCAcroPDDocSource.Open (arrFiles(i))
        '//////////
        nPage = objCAcroPDDocDestination.GetNumPages
        '\\\\\\\\\\
        If objCAcroPDDocDestination.InsertPages((nPage - 1), objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
          '//////////
          nBookMark = nBookMark + 1
          BookMarkRoot.createchild arrFiles(i), "this.pageNum=" & nPage, nBookMark
          '\\\\\\\\\\
          MergePDFs = True
        Else
          'failed to merge one of the PDFs
          iFailed = iFailed + 1
        End If
        objCAcroPDDocSource.Close
    Next i
objCAcroPDDocDestination.Save 1, strSaveAs 'Save it as a new name
objCAcroPDDocDestination.Close
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing
 
NoAcrobat:
If iFailed <> 0 Then
    MergePDFs = False
End If
On Error GoTo 0
End Function

You might want to adjust the bookmark text, which is the first argument passed to BookMarkRoot.createchild. For example, you might prefer this:

BookMarkRoot.createchild Mid(arrFiles(i), (InStrRev(arrFiles(i), "\") + 1)), "this.pageNum=" & nPage, nBookMark

 

by Beginner (5 points)
Great! Thank you. I will try this now and comment on the results.
by Beginner (5 points)
+1
Perfect! Thank you again. Also your suggested revision on the Bookmark text is exactly what I needed.

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

Looking for something else? Hire our professional VBA Help, instead.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

ParserMonster $25 Amazon Gift Card
Hightree $10 Amazon Gift Card
Thales1 $10 Amazon Gift Card
runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.

Register

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...