【2019年8月版】Adobe Readerを利用してPDFファイルのページ数を取得するVBAマクロ

ホーム
Excel, Office関連, Acrobat
【2019年8月版】Adobe Readerを利用してPDFファイルのページ数を取得するVBAマクロ

Excel

2019.08.6

【2019年8月版】Adobe Readerを利用してPDFファイルのページ数を取得するVBAマクロ

7年ほど前に、Acrobatを使わず、Adobe Readerで表示したPDFファイルからページ数を取得するマクロについて記事を書きました。

2012.10.09

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

mougの回答用に書いたコードです。 mougは半年でログが消えてしまうので、忘れないうちにブログの方にもコードを書いておきます。・Adobe Acrobatのない環境でのPDFファイルのページ数取得 http://www.moug.net/faq...

上記記事でも書いてある通り、バージョン依存で不安定、かつ冗長な処理なので、決してお薦めできるものではないのですが、先日Adobeのフォーラムで、上記コードに関わるスレッドを見つけました。

forums.adobe.com

Maintenance

https://forums.adobe.com/thread/2642806

まさかこのコードを使用している方が居られるとは・・・。
質問としては、Adobe ReaderのバージョンをDCにしたところマクロが動作しなくなったというものなのですが、プロパティダイアログを表示するメニューIDやダイアログの構造などが変更されているので、それはそうだろうと思います。

今回は、実用的ではないことを承知で、Acrobat Reader DCに対応した、PDFファイルのページ数を取得するマクロを書いてみました。

'※64ビット版Officeで実行する場合は要コード変更
'UIAutomationClient(UIAutomationCore.dll)要参照
Option Explicit

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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const WM_COMMAND As Long = &H111

Public Sub Sample()
  Dim num As Long
  Const PDFPath As String = "C:\Test\T e s t.pdf"
  
  num = GetPDFNumPagesUsingAdobeReader(PDFPath)
  MsgBox "[" & PDFPath & "]ファイルのページ数：" & num, vbInformation + vbSystemModal
End Sub

Private Function GetPDFNumPagesUsingAdobeReader(ByVal PDFPath As String) As Long
'Adobe Readerの[文書のプロパティ]ダイアログからPDFのページ数を取得
  Dim uiAuto As CUIAutomation
  Dim elmApp As IUIAutomationElement
  Dim elmRoot As IUIAutomationElement
  Dim elmDialog As IUIAutomationElement
  Dim elmTabItem As IUIAutomationElement
  Dim elmTextPageNumCaption As IUIAutomationElement
  Dim elmTextPageNum As IUIAutomationElement
  Dim elmButtonCancel As IUIAutomationElement
  Dim elmButtonClose As IUIAutomationElement
  Dim ptnSel As IUIAutomationSelectionItemPattern
  Dim ptnInvoke As IUIAutomationInvokePattern
  Dim hApp As Long
  Dim readerPath As String
  Dim ret As Long
  
  'Adobe Readerで指定したPDFファイルを表示
  readerPath = GetAdobeReaderPath
  If Len(Trim(GetAdobeReaderPath)) < 1 Then GoTo Fin
  Shell """" & readerPath & """" & " " & """" & PDFPath & """", vbNormalFocus
  
  'Adobe Reader取得
  '※PDF表示まで多少時間が掛かる場合有り
  Set uiAuto = New CUIAutomation
  Set elmRoot = uiAuto.GetRootElement
  Do
    Set elmApp = GetElement(uiAuto, _
                            elmRoot, _
                            UIA_ClassNamePropertyId, _
                            "AcrobatSDIWindow", _
                            UIA_WindowControlTypeId)
    Sleep 200
    DoEvents
  Loop While elmApp Is Nothing
  
  '[文書のプロパティ]ダイアログ取得
  hApp = elmApp.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
  PostMessage hApp, WM_COMMAND, &H1794, 0 '文書のプロパティ表示
  Do
    Set elmDialog = GetElement(uiAuto, _
                               elmApp, _
                               UIA_NamePropertyId, _
                               "文書のプロパティ", _
                               UIA_WindowControlTypeId)
    Sleep 200
    DoEvents
  Loop While elmDialog Is Nothing
  
  '[概要]タブ選択
  Set elmTabItem = GetElement(uiAuto, _
                              elmDialog, _
                              UIA_NamePropertyId, _
                              "概要", _
                              UIA_TabItemControlTypeId)
  If elmTabItem Is Nothing Then GoTo Fin
  Set ptnSel = elmTabItem.GetCurrentPattern(UIA_SelectionItemPatternId)
  ptnSel.Select
  
  '[ページ数]取得
  Set elmTextPageNumCaption = GetElement(uiAuto, _
                                         elmDialog, _
                                         UIA_NamePropertyId, _
                                         "ページ数 :", _
                                         UIA_TextControlTypeId)
  If elmTextPageNumCaption Is Nothing Then GoTo Fin
  Set elmTextPageNum = uiAuto.RawViewWalker.GetNextSiblingElement(elmTextPageNumCaption)
  If elmTextPageNum Is Nothing Then GoTo Fin
  ret = CLng(elmTextPageNum.CurrentName)
  
  'ダイアログを閉じてアプリケーション終了
  Set elmButtonCancel = GetElement(uiAuto, _
                                   elmDialog, _
                                   UIA_NamePropertyId, _
                                   "キャンセル", _
                                   UIA_ButtonControlTypeId)
  If elmButtonCancel Is Nothing Then GoTo Fin
  Set ptnInvoke = elmButtonCancel.GetCurrentPattern(UIA_InvokePatternId)
  ptnInvoke.Invoke
  Set elmButtonClose = GetElement(uiAuto, _
                                  elmApp, _
                                  UIA_NamePropertyId, _
                                  "閉じる", _
                                  UIA_ButtonControlTypeId)
  If elmButtonClose Is Nothing Then GoTo Fin
  Set ptnInvoke = elmButtonClose.GetCurrentPattern(UIA_InvokePatternId)
  ptnInvoke.Invoke
  
Fin:
  GetPDFNumPagesUsingAdobeReader = ret
End Function

Private Function GetAdobeReaderPath()
'Adobe Reader(AcroRd32.exe)のパスを取得
  Dim folderPath As String
  Dim filePath As String
  Dim itm As Object
  Const ExeName As String = "AcroRd32.exe"
   
  '[プログラムと機能]からAdobe Readerのインストール先フォルダを取得
  With CreateObject("Shell.Application").Namespace("shell:::{7b81be6a-ce2b-4676-a29e-eb907a5126c5}")
    For Each itm In .Items
      If InStr(LCase(itm.Name), "adobe") And InStr(LCase(itm.Name), "reader") Then
        '[Extended Asian Language font pack]は除外
        If InStr(LCase(itm.Name), "extended") < 1 Then
          folderPath = .GetDetailsOf(itm, 10)
          Exit For
        End If
      End If
    Next
  End With
  
  'Adobe Readerのパスを取得
  With CreateObject("Scripting.FileSystemObject")
    filePath = .BuildPath(folderPath, "Reader")
    filePath = .BuildPath(filePath, ExeName)
    If .FileExists(filePath) = True Then GetAdobeReaderPath = filePath
  End With
End Function

Private Function GetElement(ByVal uiAuto As CUIAutomation, _
                            ByVal elmParent As IUIAutomationElement, _
                            ByVal propertyId As Long, _
                            ByVal propertyValue As Variant, _
                            Optional ByVal ctrlType As Long = 0) As IUIAutomationElement
  Dim cndFirst As IUIAutomationCondition
  Dim cndSecond As IUIAutomationCondition
      
  Set cndFirst = uiAuto.CreatePropertyCondition( _
                   propertyId, _
                   propertyValue _
                 )
  If ctrlType <> 0 Then
    Set cndSecond = uiAuto.CreatePropertyCondition( _
                      UIA_ControlTypePropertyId, _
                      ctrlType _
                    )
    Set cndFirst = uiAuto.CreateAndCondition( _
                     cndFirst, _
                     cndSecond _
                   )
  End If
  Set GetElement = elmParent.FindFirst(TreeScope_Subtree, cndFirst)
End Function

処理の流れは下記の通りで、UI Automationを使って、アプリケーションやダイアログの操作を行っています。