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 2013 アイコン一覧(U)

    ・Office 2013 アイコン一覧 NUM…

  2. Office関連

    Chrome DevTools ProtocolでEdgeを操作するVBAマクロ

    Microsoft Edgeの操作を自動化する際はWebDriverを…

  3. Office関連

    Office 2013の開発者用リファレンス

    「Word2013 VBA の日本語ヘルプ」でも回答していますが、Of…

  4. Office関連

    「いちばんやさしいExcel VBAの教本」レビュー

    VBAの学習者であれば一度は見たことがあるであろう、超有名老舗サイト「…

  5. Office関連

    「傍点をふる」をWord 2007/2010で簡単に使う方法

    Wordで文字列を強調したいときに便利なのが「傍点をふる」コマンド。…

  6. アイコン一覧

    Office 2013 アイコン一覧(M)

    ・Office 2013 アイコン一覧 NUM…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP