VBA and Acrobat add-in to create new PDF with bookmarks

tjdickinson

Board Regular
Joined
Jun 26, 2021
Messages
61
Office Version
  1. 365
Platform
  1. Windows
My question is hopefully rather simple, but I'm relatively new to VBA and I know nothing about Acrobat API. After spending the better part of the past two days scouring the web for an answer, I've only found long-outdated results (like like this post from 2016 based on this blog from 2009 and this post from 2009) which are only partially relevant (most of the results dealt with merging two already existing PDFs), minimal documentation, and broken reference links.

I've noticed that @John_w has answered a lot of questions about Acrobat API, so I'm hoping that they might be able to help here. But of course, anyone's help is appreciated.

What I have so far is really just the beginning:
VBA Code:
Sub exportPDF(pdfExportLoc)
Dim pdfNamePath as String
pdfNamePath = pdfExportLoc & "\" & left(activeworkbook.name, len(activeworkbook.name)-5) & ".pdf"    ' adds the file name to the path and changes the extension
End Sub

After that, I'm totally lost. It seems like it should be straight forward, but I'm stuck. I really just need it to create the PDF with all worksheets in the active workbook, add a bookmark to each sheet (using the sheet name), and then save it to pdfNamePath.

Thank you in advance for any help you can give.
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
I would start by saving each sheet as a separate PDF, using ExportAsFixedFormat Type:=xlTypePDF.

Then loop through the saved PDFs and, using the Acrobat API, merge each and add a bookmark to the running total page number to create the final output PDF. For merging, see the code in this thread:


For the bookmarks, see the BookmarkRoot code here:


I think you'll need to adapt the BookmarkRoot.CreateChild line to specify the sheet name as your bookmark and, as each PDF is inserted, keep a running total of the total number of pages and use that number in the "this.pageNum=" & totalPages argument.
 
Upvote 0
I would start by saving each sheet as a separate PDF, using ExportAsFixedFormat Type:=xlTypePDF.

Then loop through the saved PDFs and, using the Acrobat API, merge each and add a bookmark to the running total page number to create the final output PDF. For merging, see the code in this thread:


For the bookmarks, see the BookmarkRoot code here:


I think you'll need to adapt the BookmarkRoot.CreateChild line to specify the sheet name as your bookmark and, as each PDF is inserted, keep a running total of the total number of pages and use that number in the "this.pageNum=" & totalPages argument.
Thanks for your reply, John_w. I have to admit, after spending the past few days almost exclusively (and fruitlessly) trying to sort out this export situation, my motivation level is extremely low. I've had a go at it, but I'm sure it's still not right. I'm new to VBA to begin with, and getting into the Adobe API has been so baffling.

I'll post my follow-up notes/questions first, and the code I have so far after. (In the code I included source links, so if I did something wrong in changing the code, you can see what the original source had.) I haven't tested it yet because I don't know where to put the bookmarks code (explained in my notes below).
  1. The first part works fine (note changing ThisWorksheet to ActiveWorksheet because the macro is in "Personal").
  2. Merging: Your link takes the file names from cells in a sheet, so I found other code that takes the files from a directory.
    1. DestFile: I don't know if I understood this correctly, but maybe it's fine. I set it to the location and file name of the final file (which of course doesn't exist yet).
    2. MyPath: I replaced the original With block with a simple declaration; hopefully it's okay.
    3. MyFiles array: I replaced the code with my own, which hopefully will work to preserve the order of the sheets (which is important).
  3. Merging (second sub): Here is where I get totally lost. Maybe, just maybe, it's essentially fine as it is, but I doubt it, and I have absolutely no ideahow to modify this code.
    1. Ultimately, I need the final file saved according to the declared pdfExportLoc variable from the first sub (which gets passed, I think, through the DestFile constant).
    2. I don't know why DestFile is declared as optional (or what this means).
    3. Maybe there's an easier/simpler way to merge the PDFs? This seems like a very long and complicated bit of code.
  4. Bookmarks: should this go in the second sub? I don't know where it belongs, though, because I don't understand the second sub at all.
    1. I had a go at defining the bookmarks, but I'm not sure I understand the syntax correctly. I think it's something like "create this bookmark on this page"...but I don't know what the third part refers to.
    2. If the bookmark creation is put in the second sub, then the shtArray() variable needs to be passed to that sub as well. I've done that already just to be safe.
  5. The last thing is to delete the temporary folder, which I think I coded correctly at the end of the first sub.
Here's hoping that most of this code is correct. Thanks again for your tremendous help.
VBA Code:
Sub sndbxExportPDF() 'pdfExportLoc)
'=== John_w's suggestion: create separate PDFs for each sheet with exportasfixedformat, loop through saved PDFs and use acrobat api to merge and add bookmarks

'temporary pdfExportLoc (will be replaced by a pushed variable in the sub declaration)
Dim pdfExportLoc As String
pdfExportLoc = ActiveWorkbook.Path
'end temp
pdfExportLoc = pdfExportLoc & "\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & ".pdf"

' save each sheet as separate PDF | source: https://exceloffthegrid.com/vba-code-save-excel-file-as-pdf/#Loop_through_sheets
Dim ws As Worksheet
Dim tempFolder As String

tempFolder = ActiveWorkbook.Path & "\Temp"

If Dir(tempFolder, vbDirectory) = vbNullString Then    'Create temporary folder
    MkDir tempFolder
End If

For Each ws In ActiveWorkbook.Worksheets    'Loop through all worksheets and save as individual PDF in Temp folder
    ws.ExportAsFixedFormat Type:=xlTypePDF, _
        fileName:=tempFolder & "\" & ws.Name & ".pdf"
Next

'**** The above is tested and works. What follows has not been tested.

' I've not used John_w's merge link 1 because it takes everything from cells in a sheet; I found the following code to merge files in a directory | source: http://www.vbaexpress.com/forum/showthread.php?47310-Need-code-to-merge-PDF-files-in-a-folder-using-adobe-acrobat-X&p=295941&viewfull=1#post295941
Const DestFile As String = pdfExportLoc & "\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & ".pdf"  ' << I don't know if this will work because this file doesn't exist (yet)

Dim MyPath As String, MyFiles As String
Dim i As Long  ' << removed variables a() and f because of changed code

' I replaced the With block defining MyPath with a simple declaration setting MyPath to the tempFolder
MyPath = tempFolder & "\"

' I replaced the code here (array a() ) with something I wrote yesterday and have modified, which hopefully will work to preserve the order of the sheets
Dim ws As Worksheet
Dim shtArray() As String
Dim intA As Integer

For Each ws In ActiveWorkbook.Worksheets
    intA = intA + 1
    ReDim Preserve shtArray(intA)
    shtArray(intA) = tempFolder & "\" & ws.Name & ".pdf"
Next ws
                    
If i Then    ' Merge PDFs
    ReDim Preserve shtArray(1 To i)
    MyFiles = Join(shtArray, ",")
    Application.StatusBar = "Merging, please wait ..."
    Call MergePDFs(MyPath, MyFiles, shtArray, DestFile)  ' << go to the next sub
    Application.StatusBar = False
Else
    MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
End If

' merge pdf and set bookmarks (from John_w's answer) | source: https://www.mrexcel.com/board/threads/create-pdf-bookmarks-while-combinding-files-with-vba-in-excel.847138/#post-4124136 _
  Maybe this part belongs in the next sub when it merges the files?
Dim insertSuccess As Boolean
Dim n As Long, p As Long
Dim JSO As Object, BookmarkRoot As Object
    
p = objAcroPDDocDestination.GetNumPages
insertSuccess = objAcroPDDocDestination.InsertPages(p - 1, objAcroPDDocSource, 0, objAcroPDDocSource.GetNumPages, 0)

If insertSuccess Then
    Set JSO = objAcroPDDocDestination.GetJSObject
    Set BookmarkRoot = JSO.BookmarkRoot
    n = UBound(BookmarkRoot.Children) + 1
    BookmarkRoot.createChild shtArray(n), "this.pageNum=" & p, n  ' << I don't know if I updated this correctly
End If

objAcroPDDocDestination.Save 1, FromPath & ParentFolder & ParentFile
objAcroPDDocSource.Close

' Delete the temporary folder | source: https://www.automateexcel.com/vba/deletefolder/
Dim FSO As New FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
 
FSO.DeleteFolder tempFolder, False

End Sub

Sub MergePDFs(MyPath As String, MyFiles As String, shtArray As String, Optional DestFile As String)

' This entire sub is Greek to me. I don't understand any of it, and I have no idea what needs to be changed. Maybe it's fine as it, but I doubt it.
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.AcroPDDoc

If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"  ' << this whole block is also in the previous sub...seems redundant...
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
        n = n + ni    ' Calc the number of pages in the merged document
        PartDocs(i).Close    ' Release the memory
        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_:
If Err Then    ' Inform about error/success
    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

If Not PartDocs(0) Is Nothing Then PartDocs(0).Close    ' Release the memory
Set PartDocs(0) = Nothing

AcroApp.Exit    ' Quit Acrobat application
Set AcroApp = Nothing
 
End Sub
 
Upvote 0
Thanks for posting your attempt. Rather than answering your questions, based on combining different bits of code, which is difficult for a beginner, it's easier for me to just post my macro and see if you can follow the code. I've included a few comments to help you and hopefully answer some of your questions.

VBA Code:
'References: Adobe Acrobat nn.0 Type Library

Option Explicit

Public Sub Save_Sheets_As_PDF_With_Bookmarks()

    Dim PDFexportFolder As String
    Dim PDFfiles() As String, bookmarkNames() As String
    Dim n As Long
    Dim ws As Worksheet
    
    'Folder where final PDF output file will be saved.  Also used for temporary PDFs for each sheet
    
    PDFexportFolder = "D:\Temp\Excel\PDF\"
    
    'Save each sheet as a temporary PDF.  Store the full name of each PDF in the PDFfiles array and each sheet name in the bookmarkNames array
    
    n = 0
    For Each ws In ActiveWorkbook.Worksheets
        ReDim Preserve PDFfiles(n)
        ReDim Preserve bookmarkNames(n)
        PDFfiles(n) = PDFexportFolder & ws.Name & ".pdf"
        bookmarkNames(n) = ws.Name
        If Dir(PDFfiles(n)) <> vbNullString Then Kill PDFfiles(n)
        ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfiles(n), _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        n = n + 1
    Next
    
    'Append all PDFs and add bookmarks to create the final output PDF
    
    Append_PDFs_Add_Bookmarks PDFfiles, bookmarkNames, PDFexportFolder & Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & ".pdf"
    
    'Delete the temporary PDFs for the sheets
    
    For n = 0 To UBound(PDFfiles)
        Kill PDFfiles(n)
    Next
    
End Sub


Private Sub Append_PDFs_Add_Bookmarks(PDFinputFiles() As String, bookmarkNames() As String, PDFoutputFile As String)
     
    Dim AcroApp As New Acrobat.AcroApp
    Dim finalPDF As Acrobat.CAcroPDDoc
    Dim nextPDF As Acrobat.CAcroPDDoc
    Dim JSO As Object
    Dim BookmarkRoot As Object
    Dim bookmarkIndex As Long
    Dim i As Long, totalPages As Long, numPages As Long
    Dim insertSuccess As Boolean
     
    'Delete the appended PDF if it already exists
    
    If Dir(PDFoutputFile) <> "" Then Kill PDFoutputFile
    
    Set finalPDF = CreateObject("AcroExch.PDDoc")
    Set nextPDF = CreateObject("AcroExch.PDDoc")
    
    'Open the first PDF file.  All other PDF files will be appended to this file, and the final file will be saved as a new PDF
    
    finalPDF.Open PDFinputFiles(0)
    totalPages = finalPDF.GetNumPages()
    
    Set JSO = finalPDF.GetJSObject
    Set BookmarkRoot = JSO.BookmarkRoot
    
    'Add the first bookmark to the first page.  Page numbers and bookmark indexes start at zero
    
    bookmarkIndex = 0
    BookmarkRoot.CreateChild bookmarkNames(0), "this.pageNum=0", bookmarkIndex

    'Loop through the other PDF files
    
    For i = 1 To UBound(PDFinputFiles)
         
        'Open this PDF and append its pages to the final PDF
        
        nextPDF.Open PDFinputFiles(i)
        numPages = nextPDF.GetNumPages()
        
        insertSuccess = finalPDF.InsertPages(totalPages - 1, nextPDF, 0, numPages, True)
        
        If insertSuccess Then
        
            'This PDF successfully appended, so add bookmark pointing to its first page in the final PDF
            
            bookmarkIndex = bookmarkIndex + 1
            BookmarkRoot.CreateChild bookmarkNames(i), "this.pageNum=" & totalPages, bookmarkIndex
        
            'Update the total number of pages in the final PDF
        
            totalPages = totalPages + numPages
        
        Else
        
            MsgBox "Cannot insert pages of" & vbLf & PDFinputFiles(i), vbExclamation, "Append PDFs failed"
        
        End If
                
        nextPDF.Close

    Next
     
    Set nextPDF = Nothing
     
    'Save the final PDF with all PDFs appended as a new file
    
    If finalPDF.Save(PDSaveFull, PDFoutputFile) Then
        MsgBox "Successfully created final PDF file" & vbLf & vbLf & PDFoutputFile, vbInformation, "Append PDFs completed"
    Else
        MsgBox "Cannot save final PDF file" & vbLf & vbLf & PDFoutputFile, vbExclamation, "Append PDFs failed"
    End If
     
    'Release memory
    
    If Not finalPDF Is Nothing Then finalPDF.Close
    Set finalPDF = Nothing
     
    'Quit Acrobat application
    
    AcroApp.Exit
    Set AcroApp = Nothing
     
End Sub
 
Upvote 0
Solution
Thanks for posting your attempt. Rather than answering your questions, based on combining different bits of code, which is difficult for a beginner, it's easier for me to just post my macro and see if you can follow the code. I've included a few comments to help you and hopefully answer some of your questions.

VBA Code:
'References: Adobe Acrobat nn.0 Type Library

Option Explicit

Public Sub Save_Sheets_As_PDF_With_Bookmarks()

    Dim PDFexportFolder As String
    Dim PDFfiles() As String, bookmarkNames() As String
    Dim n As Long
    Dim ws As Worksheet
   
    'Folder where final PDF output file will be saved.  Also used for temporary PDFs for each sheet
   
    PDFexportFolder = "D:\Temp\Excel\PDF\"
   
    'Save each sheet as a temporary PDF.  Store the full name of each PDF in the PDFfiles array and each sheet name in the bookmarkNames array
   
    n = 0
    For Each ws In ActiveWorkbook.Worksheets
        ReDim Preserve PDFfiles(n)
        ReDim Preserve bookmarkNames(n)
        PDFfiles(n) = PDFexportFolder & ws.Name & ".pdf"
        bookmarkNames(n) = ws.Name
        If Dir(PDFfiles(n)) <> vbNullString Then Kill PDFfiles(n)
        ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfiles(n), _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        n = n + 1
    Next
   
    'Append all PDFs and add bookmarks to create the final output PDF
   
    Append_PDFs_Add_Bookmarks PDFfiles, bookmarkNames, PDFexportFolder & Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & ".pdf"
   
    'Delete the temporary PDFs for the sheets
   
    For n = 0 To UBound(PDFfiles)
        Kill PDFfiles(n)
    Next
   
End Sub


Private Sub Append_PDFs_Add_Bookmarks(PDFinputFiles() As String, bookmarkNames() As String, PDFoutputFile As String)
    
    Dim AcroApp As New Acrobat.AcroApp
    Dim finalPDF As Acrobat.CAcroPDDoc
    Dim nextPDF As Acrobat.CAcroPDDoc
    Dim JSO As Object
    Dim BookmarkRoot As Object
    Dim bookmarkIndex As Long
    Dim i As Long, totalPages As Long, numPages As Long
    Dim insertSuccess As Boolean
    
    'Delete the appended PDF if it already exists
   
    If Dir(PDFoutputFile) <> "" Then Kill PDFoutputFile
   
    Set finalPDF = CreateObject("AcroExch.PDDoc")
    Set nextPDF = CreateObject("AcroExch.PDDoc")
   
    'Open the first PDF file.  All other PDF files will be appended to this file, and the final file will be saved as a new PDF
   
    finalPDF.Open PDFinputFiles(0)
    totalPages = finalPDF.GetNumPages()
   
    Set JSO = finalPDF.GetJSObject
    Set BookmarkRoot = JSO.BookmarkRoot
   
    'Add the first bookmark to the first page.  Page numbers and bookmark indexes start at zero
   
    bookmarkIndex = 0
    BookmarkRoot.CreateChild bookmarkNames(0), "this.pageNum=0", bookmarkIndex

    'Loop through the other PDF files
   
    For i = 1 To UBound(PDFinputFiles)
        
        'Open this PDF and append its pages to the final PDF
       
        nextPDF.Open PDFinputFiles(i)
        numPages = nextPDF.GetNumPages()
       
        insertSuccess = finalPDF.InsertPages(totalPages - 1, nextPDF, 0, numPages, True)
       
        If insertSuccess Then
       
            'This PDF successfully appended, so add bookmark pointing to its first page in the final PDF
           
            bookmarkIndex = bookmarkIndex + 1
            BookmarkRoot.CreateChild bookmarkNames(i), "this.pageNum=" & totalPages, bookmarkIndex
       
            'Update the total number of pages in the final PDF
       
            totalPages = totalPages + numPages
       
        Else
       
            MsgBox "Cannot insert pages of" & vbLf & PDFinputFiles(i), vbExclamation, "Append PDFs failed"
       
        End If
               
        nextPDF.Close

    Next
    
    Set nextPDF = Nothing
    
    'Save the final PDF with all PDFs appended as a new file
   
    If finalPDF.Save(PDSaveFull, PDFoutputFile) Then
        MsgBox "Successfully created final PDF file" & vbLf & vbLf & PDFoutputFile, vbInformation, "Append PDFs completed"
    Else
        MsgBox "Cannot save final PDF file" & vbLf & vbLf & PDFoutputFile, vbExclamation, "Append PDFs failed"
    End If
    
    'Release memory
   
    If Not finalPDF Is Nothing Then finalPDF.Close
    Set finalPDF = Nothing
    
    'Quit Acrobat application
   
    AcroApp.Exit
    Set AcroApp = Nothing
    
End Sub
You're a champ, @John_w , thanks. I was just in the process of testing and trying to debug what I had. (Revised code below.) I commented out the bookmarks and delete temp folder just to see if I could get the files to merge. The problem it seems to be having now is that somewhere in the second sub (I think), it's adding the path name again before it tries to find the file; the msgbox says something like "Cannot find file G:\...G:\... .pdf". Since all the variables in the first sub are correct, it must be happening in the second sub.

I'll have a look now at your code and see what I can figure out. Thanks again for the help! I can taste the end...I really ought to be getting ready for my lessons tomorrow, but I can't help but want to get this project wrapped up.

VBA Code:
Sub sndbxExportPDF() 'pdfExportLoc)
'=== John_w's suggestion: create separate PDFs for each sheet with exportasfixedformat, loop through saved PDFs and use acrobat api to merge and add bookmarks

'temporary pdfExportLoc (will be replaced by a pushed variable in the sub declaration)
Dim pdfExportLoc As String
pdfExportLoc = ActiveWorkbook.Path
'end temp
pdfExportLoc = pdfExportLoc & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & ".pdf"

' save each sheet as separate PDF | source: https://exceloffthegrid.com/vba-code-save-excel-file-as-pdf/#Loop_through_sheets
Dim ws As Worksheet
Dim tempFolder As String

tempFolder = ActiveWorkbook.Path & "\Temp"

If Dir(tempFolder, vbDirectory) = vbNullString Then    'Create temporary folder
    MkDir tempFolder
End If

For Each ws In ActiveWorkbook.Worksheets    'Loop through all worksheets and save as individual PDF in Temp folder
    ws.ExportAsFixedFormat Type:=xlTypePDF, _
        fileName:=tempFolder & "\" & ws.Name & ".pdf"
Next

'**** The above is tested and works. What follows has not been tested.

' I've not used John_w's merge link 1 because it takes everything from cells in a sheet; I found the following code to merge files in a directory | source: http://www.vbaexpress.com/forum/showthread.php?47310-Need-code-to-merge-PDF-files-in-a-folder-using-adobe-acrobat-X&p=295941&viewfull=1#post295941
Dim DestFile As String
DestFile = pdfExportLoc  ' << I don't know if this will work because this file doesn't exist (yet)

Dim MyPath As String, MyFiles As String
Dim i As Long  ' << removed variables a() and f because of changed code

' I replaced the With block defining MyPath with a simple declaration setting MyPath to the tempFolder
MyPath = tempFolder & "\"

' I replaced the code here (array a() ) with something I wrote yesterday and have modified, which hopefully will work to preserve the order of the sheets
'Dim ws As Worksheet
Dim shtArray() As String
Dim intA As Integer

For Each ws In ActiveWorkbook.Worksheets
    intA = intA + 1
    ReDim Preserve shtArray(intA)
    shtArray(intA) = tempFolder & "\" & ws.Name & ".pdf"
Next ws
                    
If intA Then    ' Merge PDFs
    'ReDim Preserve shtArray(1 To intA)
    MyFiles = Join(shtArray, ",")
    Application.StatusBar = "Merging, please wait ..."
    Call MergePDFs(MyPath, MyFiles, shtArray, DestFile)  ' << go to the next sub
    Application.StatusBar = False
Else
    MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
End If

'' merge pdf and set bookmarks (from John_w's answer) | source: https://www.mrexcel.com/board/threads/create-pdf-bookmarks-while-combinding-files-with-vba-in-excel.847138/#post-4124136 _
'  Maybe this part belongs in the next sub when it merges the files?
'Dim insertSuccess As Boolean
'Dim n As Long, p As Long
'Dim JSO As Object, BookmarkRoot As Object
'
'p = objAcroPDDocDestination.GetNumPages
'insertSuccess = objAcroPDDocDestination.InsertPages(p - 1, objAcroPDDocSource, 0, objAcroPDDocSource.GetNumPages, 0)
'
'If insertSuccess Then
'    Set JSO = objAcroPDDocDestination.GetJSObject
'    Set BookmarkRoot = JSO.BookmarkRoot
'    n = UBound(BookmarkRoot.Children) + 1
'    BookmarkRoot.createChild shtArray(n), "this.pageNum=" & p, n  ' << I don't know if I updated this correctly
'End If
'
'objAcroPDDocDestination.Save 1, FromPath & ParentFolder & ParentFile
'objAcroPDDocSource.Close

' Delete the temporary folder | source: https://www.automateexcel.com/vba/deletefolder/
'Set FSO = CreateObject("Scripting.FileSystemObject")
 
'FSO.DeleteFolder tempFolder, False

End Sub

Sub MergePDFs(MyPath As String, MyFiles As String, shtArray, Optional DestFile)

' This entire sub is Greek to me. I don't understand any of it, and I have no idea what needs to be changed. Maybe it's fine as it, but I doubt it.
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.AcroPDDoc

If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"  ' << this whole block is also in the previous sub...seems redundant...
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
        n = n + ni    ' Calc the number of pages in the merged document
        PartDocs(i).Close    ' Release the memory
        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_:
If Err Then    ' Inform about error/success
    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

If Not PartDocs(0) Is Nothing Then PartDocs(0).Close    ' Release the memory
Set PartDocs(0) = Nothing

AcroApp.Exit    ' Quit Acrobat application
Set AcroApp = Nothing
 
End Sub
 
Upvote 0
Thanks for posting your attempt. Rather than answering your questions, based on combining different bits of code, which is difficult for a beginner, it's easier for me to just post my macro and see if you can follow the code. I've included a few comments to help you and hopefully answer some of your questions.

VBA Code:
'References: Adobe Acrobat nn.0 Type Library

Option Explicit

Public Sub Save_Sheets_As_PDF_With_Bookmarks()

    Dim PDFexportFolder As String
    Dim PDFfiles() As String, bookmarkNames() As String
    Dim n As Long
    Dim ws As Worksheet
   
    'Folder where final PDF output file will be saved.  Also used for temporary PDFs for each sheet
   
    PDFexportFolder = "D:\Temp\Excel\PDF\"
   
    'Save each sheet as a temporary PDF.  Store the full name of each PDF in the PDFfiles array and each sheet name in the bookmarkNames array
   
    n = 0
    For Each ws In ActiveWorkbook.Worksheets
        ReDim Preserve PDFfiles(n)
        ReDim Preserve bookmarkNames(n)
        PDFfiles(n) = PDFexportFolder & ws.Name & ".pdf"
        bookmarkNames(n) = ws.Name
        If Dir(PDFfiles(n)) <> vbNullString Then Kill PDFfiles(n)
        ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfiles(n), _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        n = n + 1
    Next
   
    'Append all PDFs and add bookmarks to create the final output PDF
   
    Append_PDFs_Add_Bookmarks PDFfiles, bookmarkNames, PDFexportFolder & Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & ".pdf"
   
    'Delete the temporary PDFs for the sheets
   
    For n = 0 To UBound(PDFfiles)
        Kill PDFfiles(n)
    Next
   
End Sub


Private Sub Append_PDFs_Add_Bookmarks(PDFinputFiles() As String, bookmarkNames() As String, PDFoutputFile As String)
    
    Dim AcroApp As New Acrobat.AcroApp
    Dim finalPDF As Acrobat.CAcroPDDoc
    Dim nextPDF As Acrobat.CAcroPDDoc
    Dim JSO As Object
    Dim BookmarkRoot As Object
    Dim bookmarkIndex As Long
    Dim i As Long, totalPages As Long, numPages As Long
    Dim insertSuccess As Boolean
    
    'Delete the appended PDF if it already exists
   
    If Dir(PDFoutputFile) <> "" Then Kill PDFoutputFile
   
    Set finalPDF = CreateObject("AcroExch.PDDoc")
    Set nextPDF = CreateObject("AcroExch.PDDoc")
   
    'Open the first PDF file.  All other PDF files will be appended to this file, and the final file will be saved as a new PDF
   
    finalPDF.Open PDFinputFiles(0)
    totalPages = finalPDF.GetNumPages()
   
    Set JSO = finalPDF.GetJSObject
    Set BookmarkRoot = JSO.BookmarkRoot
   
    'Add the first bookmark to the first page.  Page numbers and bookmark indexes start at zero
   
    bookmarkIndex = 0
    BookmarkRoot.CreateChild bookmarkNames(0), "this.pageNum=0", bookmarkIndex

    'Loop through the other PDF files
   
    For i = 1 To UBound(PDFinputFiles)
        
        'Open this PDF and append its pages to the final PDF
       
        nextPDF.Open PDFinputFiles(i)
        numPages = nextPDF.GetNumPages()
       
        insertSuccess = finalPDF.InsertPages(totalPages - 1, nextPDF, 0, numPages, True)
       
        If insertSuccess Then
       
            'This PDF successfully appended, so add bookmark pointing to its first page in the final PDF
           
            bookmarkIndex = bookmarkIndex + 1
            BookmarkRoot.CreateChild bookmarkNames(i), "this.pageNum=" & totalPages, bookmarkIndex
       
            'Update the total number of pages in the final PDF
       
            totalPages = totalPages + numPages
       
        Else
       
            MsgBox "Cannot insert pages of" & vbLf & PDFinputFiles(i), vbExclamation, "Append PDFs failed"
       
        End If
               
        nextPDF.Close

    Next
    
    Set nextPDF = Nothing
    
    'Save the final PDF with all PDFs appended as a new file
   
    If finalPDF.Save(PDSaveFull, PDFoutputFile) Then
        MsgBox "Successfully created final PDF file" & vbLf & vbLf & PDFoutputFile, vbInformation, "Append PDFs completed"
    Else
        MsgBox "Cannot save final PDF file" & vbLf & vbLf & PDFoutputFile, vbExclamation, "Append PDFs failed"
    End If
    
    'Release memory
   
    If Not finalPDF Is Nothing Then finalPDF.Close
    Set finalPDF = Nothing
    
    'Quit Acrobat application
   
    AcroApp.Exit
    Set AcroApp = Nothing
    
End Sub
Wow, brilliant, this worked perfectly. Thank you SO much for your help, John_w. You've helped me finally finish a project I've spent probably far too long on, and it's a huge relief. I can't thank you enough.
 
Upvote 0

Forum statistics

Threads
1,223,880
Messages
6,175,153
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top