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関連

    オフィス祭り 2018 in 東京が9月15日(土)に開催されます。

    突然ですが、私はMicrosoft Officeが大好きです。20…

  2. Office関連

    マクロに割り当てたショートカットキーをCSVファイルとして出力するWordマクロ

    Word MVPの新田さんが書かれた以下の記事を見て思いついたマクロで…

  3. Office関連

    VBE用のCOMアドインをメモ帳で作ってみる。

    “Officeアプリケーション用のCOMアドインをVisual Stu…

  4. Office関連

    サジェスト機能を利用したWord用ツール

    「Webサービスのサジェスト機能についてまとめてみました。」でWebサ…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP