Office関連

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

先日Adobe Readerを利用してPDFファイルのページ数を取得するVBAマクロについて記事を書きましたが、タイミングよく「Adobe Reader XI」が公開されましたので、XI用にマクロを修正してみました(といってもメニューIDを直しただけですが…)。

'標準モジュール
'※ Adobe Reader XI環境で実行
'※ その他環境では動作しない可能性があります。
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 11.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, &H1788, 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, &H1791, 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

一応”PDFファイルのページ数を取得する“という目的は達成できますが、やはり無理やり感は否めないですね。

関連記事

  1. Office関連

    選択したセルに連続行番号を振るWordマクロ

    Wordでマニュアルを作成するとき等、表の中で連番を振りたいときがよく…

  2. Office関連

    日経ソフトウエア 2014年 10月号 「VBAでExcelを業務アプリ化」

    購読している雑誌、日経ソフトウエア 2014年 10月号に「イベントプ…

  3. Office関連

    外部アプリケーションのコンボボックスの内容を取得するVBAマクロのサンプル

    Q&Aサイトに下記質問がありました。(この質問も何となく似たような…

  4. Office関連

    目次を更新するWordマクロ

    文書の目次を更新するにはTableOfContentsオブジェクトのU…

  5. Office アドイン

    [Officeアドイン]マニフェストファイルをデバッグする方法

    Office アドイン本体はF12ツール等を使ってデバッグすることがで…

  6. Office関連

    プログラムのソースコードを別の言語に変換するVBAマクロ

    SharpDevelopが公開している、ソースコードを変換するAPI「…

コメント

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

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP