「VBA Acrobat しおり数」といったキーワード検索でのアクセスがありました。
VBAからPDFファイルに含まれるしおりの数を取得する方法を探している方だろうと思います。
Acrobat JavaScriptでしおりの情報を取得する場合、DocオブジェクトのbookmarkRootプロパティ(Bookmarkオブジェクト)を使うことになります。
VBAから扱う場合も同様で、GetJSObjectメソッド経由で大元のBookmarkオブジェクト(bookmarkRoot)を取得すると、childrenプロパティから各Bookmarkオブジェクトの操作をすることができます。
具体的なコードは下記の通りで、コードを実行すると、しおりの数と各しおりが何ページ目にあるかをDebug.Printで出力します。
Option Explicit Public Sub Sample() Dim app As Object 'AcroApp Dim avdoc As Object 'AcroAVDoc Dim avpv As Object 'AcroAVPageView Dim jso As Object Dim br As Object Dim cld As Variant Dim i As Long Const PdfFilePath = "C:\Test\Test001.pdf" Set app = CreateObject("AcroExch.App") Set avdoc = CreateObject("AcroExch.AVDoc") If avdoc.Open(PdfFilePath, "") = True Then app.Show 'アプリケーション表示 Set avpv = avdoc.GetAVPageView Set jso = avdoc.GetPDDoc.GetJSObject Set br = CallByName(jso, "bookmarkRoot", VbGet) cld = CallByName(br, "children", VbGet) Debug.Print "しおりの数:" & UBound(cld) + 1 For i = LBound(cld) To UBound(cld) CallByName cld(i), "execute", VbMethod 'しおり選択 Debug.Print "名前:" & CallByName(cld(i), "name", VbGet) & vbTab & _ "ページ:" & avpv.GetPageNum + 1 Next avdoc.Close 1 app.Hide: app.Exit End If TerminateAcrobat 'プロセスが残った場合強制終了 End Sub Private Sub TerminateAcrobat() 'Acrobatのプロセス強制終了 Dim items As Object Dim item As Object Set items = CreateObject("WbemScripting.SWbemLocator") _ .ConnectServer.ExecQuery("Select * From Win32_Process Where Name = 'Acrobat.exe'") If items.Count > 0 Then For Each item In items item.Terminate Next End If End Sub
通常、アプリケーション(AcroApp)をExitすればプロセスも消えてくれるはずなのですが、上記コードを試したときは何故かプロセスが残り続けてしまったので、仕方なく強制終了する処理を入れることにしました。
2021/1/6 追記:
上記コードを一部修正し、PDFの複数階層のしおり情報を取得するVBAマクロを書いてみました。
きぬあさ さん、 はじめまして。
PDFのしおり数の取得の件でお願いがあります。
PDF内の全てのしおり数(階層にかかわらず全て)と、そのしおりが何ページ目にあるかを
取得する方法を教えていただけませんでしょうか。
どうかよろしくお願いいたします。