Link to home
Start Free TrialLog in
Avatar of BFanguy
BFanguyFlag for United States of America

asked on

Adobe Acrobat X vba PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) does not create bookmarks

Found this awesome bit of code to create a single pdf file from a given folder, but i can't get it to create bookmarks when inserting.

In the Acrobat and PDF Library API Reference: InsertPages(long nInsertPageAfter,  LPDISPATCH iPDDocSource,long nStartPage, long nNumPages, long bBookmarks)   For bBookMarks - If a positive number, bookmarks are copied from the source document. If 0, they are not.

I found the i have tried all of these options:

PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, Ni, True)
PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, Ni, 1)
PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, Ni, -1)

What am i missing?  any help would be greatly appreciated.

Private Sub Command75_Click()
On Error GoTo Err_Command75_Click
    Const DestFile As String = "MergedFile.pdf" ' <-- change to suit
    Dim MyPath As String, MyFiles As String
    Dim a() As String, i As Long, f As String
     ' Choose the folder or just replace that part by: MyPath = Range("E3")
    With Application.FileDialog(msoFileDialogFolderPicker)
         '.InitialFileName = "C:\Temp\"
        .AllowMultiSelect = False
        If .Show = False Then Exit Sub
        MyPath = .SelectedItems(1)
        DoEvents
    End With

  ' Populate the array a() by PDF file names
    If right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    ReDim a(1 To 2 ^ 14)
    f = Dir(MyPath & "*.pdf")
    While Len(f)
        If StrComp(f, DestFile, vbTextCompare) Then
            i = i + 1
            a(i) = f
        End If
        f = Dir()
    Wend
     ' Merge PDFs
    If i Then
        ReDim Preserve a(1 To i)
        MyFiles = Join(a, ",")
    '    Application.StatusBar = "Merging, please wait ..."
        Call MergePDFs(MyPath, MyFiles, DestFile)
     '   Application.StatusBar = False
    Else
        MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
    End If

Exit_Command75_Click:
    Exit Sub
Err_Command75_Click:
    MsgBox err.Description
    Resume Exit_Command75_Click
End Sub

Public 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-fol der-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

    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
            If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, Ni, -1) 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

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of BFanguy
BFanguy
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of BFanguy

ASKER

not possible with insertpages