PDF文件操作系列之五：向PDF文件添加书签

lss001

*********************************************
运行代码前请安装：
相应软件
并在Vbe工具中引用：
相应对象
注意：书签动作只能在相应软件中打开时才生效！

lss001

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Public Const PDSaveIncremental = &H0
Public Const PDSaveFull = &H1
Public Const PDSaveCopy = &H2
Public Const PDSaveLinearized = &H4
Public Const PDSaveBinaryOK = &H10
Public Const PDSaveCollectGarbage = &H20

Sub JSOcreateChild() '添加书签
    Dim lRet&, i&, jso As Object, objRootBM As Object
    Dim objBookMark(5) As Object, result As Variant

    Set AcroApp = CreateObject("AcroExch.App")
    Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
    Set AcroPDDoc = CreateObject("AcroExch.PDDoc")
   
    Const sFILE = ThisWorkbook.Path & "\num.pdf"
    lRet = AcroApp.CloseAllDocs
    lRet = AcroAVDoc.Open(sFILE, "")
    Set AcroPDDoc = AcroAVDoc.GetPDDoc
    AcroApp.Show
    Set jso = AcroPDDoc.GetJSObject
    If Not jso Is Nothing Then
        Set objRootBM = jso.bookmarkroot
        With objRootBM
            .createChild "1.Test1", "this.pageNum=0; app.beep(0);", 0
            .createChild "1.1 Test1-1", "this.pageNum=1", 1
            .createChild "1.2 Test1-2", "this.pageNum=2", 2
            .createChild "2.Test2", "this.pageNum=3", 3
            .createChild "2.1 Test2-1", "this.pageNum=4", 4
            .createChild "2.1.1 Test2-1-1", "this.pageNum=5", 5
        End With
        
        result = objRootBM.Children
        For i = 0 To UBound(objBookMark)
            Set objBookMark(i) = result(i)
        Next i
        objBookMark(0).insertChild objBookMark(1), 0
        objBookMark(0).insertChild objBookMark(2), 1
        objBookMark(3).insertChild objBookMark(4), 0
        objBookMark(4).insertChild objBookMark(5), 0
        For i = 0 To UBound(objBookMark)
            Set objBookMark(i) = Nothing
        Next i
        Set objRootBM = Nothing
        Set result = Nothing

    End If
    DoEvents: Sleep 2000
    lRet = AcroPDDoc.Save(PDSaveIncremental, sFILE)
    AcroApp.CloseAllDocs
    AcroApp.Hide
    AcroApp.Exit
    Set jso = Nothing
    Set AcroPDDoc = Nothing
    Set AcroAVDoc = Nothing
    Set AcroApp = Nothing
   
End Sub