Office関連

Adobe Readerを利用してPDFファイルのページ数を取得するVBAマクロ

mougの回答用に書いたコードです。
mougは半年でログが消えてしまうので、忘れないうちにブログの方にもコードを書いておきます。

・Adobe Acrobatのない環境でのPDFファイルのページ数取得
http://www.moug.net/faq/viewtopic.php?t=64473

'標準モジュール
'※ Adobe Reader X環境で実行
'※ その他環境では動作しない可能性があります。
Option Explicit

Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const GW_HWNDNEXT As Long = 2
Private Const TCM_SETCURFOCUS As Long = &H1330
Private Const WM_COMMAND As Long = &H111
Private Const AppPath As String = "C:\Program Files\Adobe\Reader 10.0\Reader\AcroRd32.exe" 'Adobe Readerのパス
Private hPage As Long

Public Sub Sample()
  Dim num As Long
  
  num = GetPDFPages("C:\Test\001.pdf")
  If num = 0& Then
    Debug.Print "Err."
  Else
    Debug.Print "ページ数:" & num
  End If
End Sub

Public Function GetPDFPages(ByVal PdfPath As String) As Long
  Dim hApp As Long, hDlg As Long, hTab As Long, hPageNum As Long
  Dim cmd As String
  Dim winName As String
  Dim buf As String * 255
  Dim ret As Long
  Dim timeLimit As Date
  
  ret = 0& '初期化
  cmd = """" & AppPath & """" & " " & """" & PdfPath & """"
  Shell cmd, vbNormalFocus 'Adobe Reader起動
  'CreateObject("Shell.Application").ShellExecute """" & PdfPath & """" '関連付けされている場合はこちらでも可
  timeLimit = DateAdd("s", 5, Now()) 'ループの制限時間:5秒
  Do
    hApp = FindWindowEx(0&, 0&, "AcrobatSDIWindow", vbNullString)
    Sleep 500&
    DoEvents
    If Now() > timeLimit Then Exit Do '制限時間を過ぎたらループを抜ける
  Loop While hApp = 0&
  If hApp = 0& Then GoTo Err
  PostMessage hApp, WM_COMMAND, &H1787, 0& '文書のプロパティ表示
  timeLimit = DateAdd("s", 5, Now()) 'ループの制限時間:5秒
  Do
    hDlg = FindWindowEx(0&, 0&, "#32770", "文書のプロパティ")
    Sleep 500&
    DoEvents
    If Now() > timeLimit Then Exit Do '制限時間を過ぎたらループを抜ける
  Loop While hDlg = 0&
  If hDlg = 0& Then GoTo Err
  hTab = FindWindowEx(hDlg, 0&, "GroupBox", vbNullString)
  hTab = FindWindowEx(hTab, 0&, "SysTabControl32", vbNullString)
  If hTab = 0& Then GoTo Err
  SendMessage hTab, TCM_SETCURFOCUS, 0&, 0& '「概要」タブ選択
  EnumChildWindows hDlg, AddressOf EnumChildProc, 0&
  If hPage = 0& Then GoTo Err
  hPageNum = GetWindow(hPage, GW_HWNDNEXT)
  If hPageNum = 0& Then GoTo Err
  If GetWindowText(hPageNum, buf, Len(buf)) = 0& Then GoTo Err
  winName = Left$(buf, InStr(buf, vbNullChar) - 1)
  ret = CLng(winName)
  SendMessage hDlg, WM_COMMAND, vbOK, 0& 'ダイアログを閉じる
  SendMessage hApp, WM_COMMAND, &H1790, 0& 'アプリケーション終了
Err:
  GetPDFPages = ret
End Function

Private Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
  Dim clsName As String, winName As String
  Dim buf1 As String * 255, buf2 As String * 255
  
  If GetClassName(hWnd, buf1, Len(buf1)) <> 0& Then
    clsName = Left$(buf1, InStr(buf1, vbNullChar) - 1)
    If clsName = "Static" Then
      If GetWindowText(hWnd, buf2, Len(buf2)) <> 0& Then
        winName = Left$(buf2, InStr(buf2, vbNullChar) - 1)
        If winName = "ページ数 :" Then
          hPage = hWnd
          EnumChildProc = False
          Exit Function
        End If
      End If
    End If
  End If
  EnumChildProc = True
End Function

上記コードはAdobe Readerを利用してPDFファイルのページ数を取得するもので、

1. Adobe ReaderでPDFファイルを開く。
2. 文書のプロパティダイアログを表示する。
3. 文書のプロパティダイアログからページ数を取得する。
4. 文書のプロパティダイアログを閉じる。
5. Adobe Readerを終了する。

といった処理を行っています。
ただし、メニューIDを指定してコマンドを実行している都合上、Adobe Readerのバージョンが変わると使用できなくなる上(上記コードはAdobe Reader X環境で作成)にループで表示待ちを行っているので、安定的なコードとはいえません。

そもそも”PDFファイルのページ数を取得する“ためだけに上記のような長いコードを書くのは非効率的ですので、個人的には上記コードの利用はお薦めしません(自分で書いておいてなんですが…)。

関連記事


2019/8/6 追記:
Acrobat Reader DCに対応したコードも書いてみました。

[PowerPoint]Applicationオブジェクトのイベントを利用する前のページ

[PowerShell]iTextSharpを使ってPDFファイルのページ数を取得する次のページ

関連記事

  1. アイコン一覧

    Office 365アイコン(imageMso)一覧(B)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  2. Office アドイン

    Office用アプリではalertやconfirmが使えない?

    JavaScriptでメッセージや確認ダイアログを表示する際には「al…

  3. Office関連

    OneNote + Google Apps Scriptで定期的にWebサイトのキャプチャーを撮る方…

    「“OneNote”がアップデート、URLをメールで送るだけでスクリー…

  4. Office関連

    Re: 【Wordマクロ】Word起動時に、前回終了時に開いていたファイルを表示

    Word MVPの新田さんがブログで面白い記事を書かれていました。…

  5. Office関連

    各スライドに配置されたオートシェイプからテキストを取得するPowerPointマクロ

    各スライドに配置されたオートシェイプからテキストを抜き出す処理を考えて…

コメント

    • noku
    • 2014年 11月 15日 12:34am

    はじめまして
    PDFの総ページ数をvbaより取得したところ、このページにヒットして勉強させていただいています。
    アクロバットリーダーの文書のプロパティを開く
    PostMessage hApp, WM_COMMAND, &H1787, 0& ‘文書のプロパティ表示
    がうまく動作してくれません。
    この行ではどのように解釈をすればよろしいでしょうか?
    文書のプロパティを表示するには、Ctrl+Dですが、そのコマンドを送信しているのでしょうか?
    お手数ですが、ご教授をお願いします。

    • > noku様

      当ブログ管理人のきぬあさです。

      > この行ではどのように解釈をすればよろしいでしょうか?
      > 文書のプロパティを表示するには、Ctrl+Dですが、そのコマンドを送信しているのでしょうか?

      アプリケーションに用意された各メニューはそれぞれ、内部にIDを持っています。
      そのIDをPostMessageを使ってアプリケーションに送ることで、IDに対応した処理をアプリケーションが実行してくれる、というわけなので、ショートカットキーを送信しているわけではありません。

      このIDは同じアプリケーションでもバージョンが変われば変更されることもありますので、当ページのコードで試した環境「Adobe Reader X」以外では動作しません。
      もしAdobe Reader XIをお使いでしたら、下記ページのコードをお試しください。

      http://www.ka-net.org/blog/?p=2337

      ただ、上記記事の通り、この方法は非常に効率が悪いものなので、可能であれば他の方法で処理することをお薦めいたします。

        • noku
        • 2014年 11月 19日 11:35am

        きぬあさ様

        ご教授ありがとうございます。

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP