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 アドイン

    [Office用アプリ]Mashup Awards 9にOffice 用アプリで応募できる!?

    日本最大級のWebアプリケーション開発コンテスト「Mashup Awa…

  2. Office関連

    【2017年1月版】Microsoft Edgeを操作するVBAマクロ(DOM編)(2)

    昨日の記事で、Microsoft Edgeを操作するVBAコードを改め…

  3. Office アドイン

    [Office用アプリ]サポートページにある資料へのリンクをまとめてみました。

    MicrosoftのサポートページにあるOffice 用アプリや関連技…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP