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 VBA]引数の型がVariantになっているのはなぜ?

    インストラクターのネタ帳でお馴染みの伊藤さんが先日下記の記事をアップさ…

  2. Office関連

    Word 2013では右クリックからBing検索できるようになりました。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  3. Office関連

    ビジネスITアカデミーの無料VBAセミナーに行ってきました。

    Excel MVPの伊藤さんやWord MVPの新田さんのブログ記事で…

  4. Office関連

    VALUE DOMAINで管理しているドメインをOffice 365で使用する。

    Office 365をセットアップすると設定される初期ドメイン「onm…

  5. Office関連

    PowerPoint 2013ではプレゼンテーションをmp4形式で保存できるようになりました。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  6. Office アドイン

    [Officeアドイン]枠線(目盛線)の表示・非表示を切り替える方法

    ここ二週間ほど体調を崩していたので久しぶりのブログ更新です。久…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

Chinese (Simplified)Chinese (Traditional)EnglishFrenchGermanJapaneseKoreanRussianSpanish

最近の記事

アーカイブ

PAGE TOP