Office関連

PDFのしおり情報を出力するVBAマクロ

Acrobatフォーラムの下記スレッドで当ブログへのリンクが貼られていることに気が付きました。

VBAでPDFの複数階層のしおり情報を取得したいとのことで、下記記事を参考にされたようです。

上記記事のコードは一番上の階層のしおりしか想定しておらず、下位のしおりの情報は取得できませんので、コードを一部修正する必要が有ります。

Acrobatの操作を行う際、最も参考になるのは公式のリファレンスですが、Bookmarkオブジェクトのページを見てみると、下記のサンプルコードが載っていました。

function DumpBookmark(bkm, nLevel)
{
    var s = "";
    for (var i = 0; i < nLevel; i++) s += " ";
    console.println(s + "+-" + bkm.name);
    if (bkm.children != null)
        for (var i = 0; i < bkm.children.length; i++)
            DumpBookmark(bkm.children[i], nLevel + 1);
}
console.clear();
console.show();
console.println("Dumping all bookmarks in the document.");
DumpBookmark(this.bookmarkRoot, 0);

なるほど。
再帰で列挙していけば良いわけですね!

上記サンプルを参考に修正したコードが下記になります。
(相変わらずAcrobatのプロセスが残り続けてしまう問題が発生してしまうようだったので、強制終了する処理を入れてあります。)

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 bkm As Object
  Const PdfFilePath = "C:\Test\テスト用文書(見出し).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 bkm = CallByName(jso, "bookmarkRoot", VbGet)
    DumpBookmark bkm, avpv
    avdoc.Close 1
    app.Hide: app.Exit
  End If
  TerminateAcrobat 'プロセスが残った場合強制終了
End Sub

Private Sub DumpBookmark(ByVal bkm As Object, ByVal avpv As Object)
'しおりの情報を出力
  Dim cld As Variant, cld2 As Variant
  
  On Error Resume Next
  cld = CallByName(bkm, "children", VbGet)
  On Error GoTo 0
  If IsEmpty(cld) = False Then
    For Each cld2 In cld
      CallByName cld2, "execute", VbMethod 'しおり選択
      Debug.Print "名前:" & CallByName(cld2, "name", VbGet) & vbTab & "ページ:" & avpv.GetPageNum + 1
      DumpBookmark cld2, avpv
    Next
  End If
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

簡単な修正ですが、一先ずこれでPDFの複数階層のしおり情報を取得できるようになりました。

2020年12月の人気記事前のページ

Power Automate経由でTwitterに投稿するVBAマクロ次のページ

関連記事

  1. Office関連

    類似した書式の文字列を選択するWordマクロ三種

    Wordには、選択中の文字列と似た書式の文字列を一括選択する「類似した…

  2. Office関連

    64ビット環境かどうかを判別するVBAマクロ

    2年以上前にMicrosoft Community(当時はMicros…

  3. Office関連

    名前付きセル(範囲)にコメントを付けるVBAマクロ

    Excelでマニュアルを作成する際、名前付きセル範囲を明記する必要があ…

  4. Office関連

    [VBA]桁を揃えてDebug.Printする。

    @CallMeKoheiさんのブログの記事に「Excel VBA イミ…

  5. Office関連

    「図のリセット」を実行するExcelマクロ

    Msdn フォーラムに「Excel2010-VBA 画像「図の書式設定…

  6. Office アドイン

    [Office用アプリ]アプリ開発コンテストの案内

    2013/9/9 追記:コンテストの受賞者が発表されました。おかげ…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP