Acrobat XIを操作してテキスト認識操作を行うVBAマクロ

ホーム
Office関連, Excel, Word, PowerPoint, Acrobat
Acrobat XIを操作してテキスト認識操作を行うVBAマクロ

2016.02.18

Acrobat XIを操作してテキスト認識操作を行うVBAマクロ

マクロからAcrobatを操作する場合「PDFファイル上のフィールドの値を操作するVBAマクロ」のように、Acrobat JavaScriptを経由することで、様々な処理を実行できます。

しかし、テキスト認識(OCR)処理はJavaScriptで実行できないようだったので、UI Automationで無理やり画面操作をしてみました。

'UIAutomationClient(UIAutomationCore.dll)要参照
Option Explicit

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 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_KEYDOWN = &H100
Private Const WM_KEYUP = &H101

Public Sub Sample()
'Acrobat XIを操作してテキスト認識操作を行うマクロ
'※ 他のバージョンのAcrobatでは実行不可
  Dim appAcrobat As Object
  Dim avdoc As Object
  Dim uiAuto As CUIAutomation
  Dim elmAcrobat As IUIAutomationElement
  Dim elmMenuBar As IUIAutomationElement
  Dim elmTagDialog As IUIAutomationElement
  Dim elmCancelButton As IUIAutomationElement
  Dim elmViewMenu As IUIAutomationElement
  Dim elmViewMenu2 As IUIAutomationElement
  Dim elmToolMenu As IUIAutomationElement
  Dim elmToolMenu2 As IUIAutomationElement
  Dim elmRecMenu As IUIAutomationElement
  Dim elmRecTree As IUIAutomationElement
  Dim elmTreeChild As IUIAutomationElement
  Dim elmRecButton As IUIAutomationElement
  Dim elmRecDialog As IUIAutomationElement
  Dim elmAllPagesButton As IUIAutomationElement
  Dim elmOKButton As IUIAutomationElement
  Dim exptn As IUIAutomationExpandCollapsePattern
  Dim iptn As IUIAutomationInvokePattern
  Dim hAcrobat As Long
  Dim hAVScrollView As Long
  Const PDSaveFull = &H1
  Const FilePath As String = "C:\Test\OCR.pdf"
  Const SaveFilePath As String = "C:\Test\OCR2.pdf"
  
  'Acrobat起動
  Set appAcrobat = CreateObject("AcroExch.App")
  Set avdoc = CreateObject("AcroExch.AVDoc")
  avdoc.Open FilePath, ""
  appAcrobat.Show
  
  hAcrobat = FindWindowEx(0, 0, "AcrobatSDIWindow", vbNullString)
  If hAcrobat = 0 Then Exit Sub
  Set uiAuto = New CUIAutomation
  Set elmAcrobat = uiAuto.ElementFromHandle(ByVal hAcrobat)
  If elmAcrobat Is Nothing Then Exit Sub
  Set elmMenuBar = GetElement(uiAuto, _
                              elmAcrobat, _
                              UIA_NamePropertyId, _
                              "アプリケーション", _
                              UIA_MenuBarControlTypeId)
  If elmMenuBar Is Nothing Then Exit Sub
  
  '[タグ付けされていない文書の読み上げ]ダイアログが表示されたら閉じる
  Sleep 1000
  Set elmTagDialog = GetElement(uiAuto, _
                                uiAuto.GetRootElement, _
                                UIA_NamePropertyId, _
                                "タグ付けされていない文書の読み上げ", _
                                UIA_WindowControlTypeId)
  If Not elmTagDialog Is Nothing Then
    Set elmCancelButton = GetElement(uiAuto, _
                                     elmTagDialog, _
                                     UIA_NamePropertyId, _
                                     "キャンセル(C)", _
                                     UIA_ButtonControlTypeId)
    If Not elmCancelButton Is Nothing Then
      Set iptn = elmCancelButton.GetCurrentPattern(UIA_InvokePatternId)
      iptn.Invoke
    End If
  End If
  
  '[表示]メニューから[テキスト認識]表示
  Set elmViewMenu = GetElement(uiAuto, _
                               elmMenuBar, _
                               UIA_NamePropertyId, _
                               "表示(V)", _
                               UIA_MenuItemControlTypeId)
  If elmViewMenu Is Nothing Then Exit Sub
  Set exptn = elmViewMenu.GetCurrentPattern(UIA_ExpandCollapsePatternId)
  exptn.Expand
  Do
    Set elmViewMenu2 = uiAuto.RawViewWalker.GetFirstChildElement(elmAcrobat)
    Sleep 100
    DoEvents
  Loop Until elmViewMenu2.CurrentName = "表示(V)"
  Set elmToolMenu = GetElement(uiAuto, _
                               elmViewMenu2, _
                               UIA_NamePropertyId, _
                               "ツール(T)", _
                               UIA_MenuItemControlTypeId)
  If elmToolMenu Is Nothing Then Exit Sub
  Set exptn = elmToolMenu.GetCurrentPattern(UIA_ExpandCollapsePatternId)
  exptn.Expand
  Do
    Set elmToolMenu2 = uiAuto.RawViewWalker.GetFirstChildElement(elmAcrobat)
    Sleep 100
    DoEvents
  Loop Until elmToolMenu2.CurrentName = "ツール(T)"
  Set elmRecMenu = GetElement(uiAuto, _
                              elmToolMenu2, _
                              UIA_NamePropertyId, _
                              "テキスト認識(T)", _
                              UIA_MenuItemControlTypeId)
  If elmRecMenu Is Nothing Then Exit Sub
  Set iptn = elmRecMenu.GetCurrentPattern(UIA_InvokePatternId)
  iptn.Invoke
  
  '[テキスト認識]ツリー項目取得
  Do
    Set elmRecTree = GetElement(uiAuto, _
                                elmAcrobat, _
                                UIA_NamePropertyId, _
                                "テキスト認識", _
                                UIA_TreeItemControlTypeId)
    Set elmTreeChild = uiAuto.RawViewWalker.GetFirstChildElement(elmRecTree)
    Sleep 100
    DoEvents
  Loop Until elmTreeChild.GetCurrentPropertyValue(UIA_LegacyIAccessibleRolePropertyId) = &HA
  hAVScrollView = FindWindowEx(hAcrobat, 0, "AVL_AVView", "AVScrollView")
  
  '[このファイル内]ボタンフォーカス→Enterキーで実行
  Do
    Set elmRecButton = GetElement(uiAuto, _
                                  elmTreeChild, _
                                  UIA_HelpTextPropertyId, _
                                  "このファイル内のテキストを認識", _
                                  UIA_ButtonControlTypeId)
    Sleep 100
    DoEvents
  Loop While elmRecButton Is Nothing
  If elmRecButton Is Nothing Then Exit Sub
  elmRecButton.SetFocus
  PostMessage hAVScrollView, WM_KEYDOWN, vbKeyReturn, 0
  PostMessage hAVScrollView, WM_KEYUP, vbKeyReturn, 0
  
  '[テキスト認識]ダイアログ操作
  Do
    Set elmRecDialog = GetElement(uiAuto, _
                                  elmAcrobat, _
                                  UIA_NamePropertyId, _
                                  "テキスト認識", _
                                  UIA_WindowControlTypeId)
    Sleep 100
    DoEvents
  Loop While elmRecDialog Is Nothing
  If elmRecDialog Is Nothing Then Exit Sub
  Set elmAllPagesButton = GetElement(uiAuto, _
                                     elmRecDialog, _
                                     UIA_NamePropertyId, _
                                     "すべてのページ(A)", _
                                     UIA_RadioButtonControlTypeId)
  If elmAllPagesButton Is Nothing Then Exit Sub
  Set iptn = elmAllPagesButton.GetCurrentPattern(UIA_InvokePatternId)
  iptn.Invoke
  Set elmOKButton = GetElement(uiAuto, _
                               elmRecDialog, _
                               UIA_NamePropertyId, _
                               "OK", _
                               UIA_ButtonControlTypeId)
  If elmOKButton Is Nothing Then Exit Sub
  Set iptn = elmOKButton.GetCurrentPattern(UIA_InvokePatternId)
  iptn.Invoke '[OK]ボタンクリック
  '※ テキスト認識処理待ちはAcrobatにまかせる
  
  'Acrobat終了
  avdoc.GetPDDoc.Save PDSaveFull, SaveFilePath
  avdoc.Close 1
  appAcrobat.Hide: appAcrobat.Exit
  
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

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

・・・後半、もう飽きました。
無理やり過ぎるので、実用性は正直皆無だと思います。

こんなコードで処理を自動化するよりは、Acrobat(Pro)の標準機能であるアクション(バッチ)機能を使用することをお薦めします。
(コードを載せておいてなんですが・・・)