VBAでUI Automationを使ってエクスプローラ操作を自動化

Windowsの操作を自動化するための UI Automation を使ってエクスプローラを自動操作してみます。

UI Automation って結構とっつきにくくて難しいですね。。
でも追加インストールなしで使えるからこれしか選択肢がない環境用です。

なかなか苦労しましたがエクスプローラを操作するサンプルを作ってみました。
動作は以下
　１）エクスプローラを起動して
　２）ファイルリストを取得して
　３）ファイルにカーソルを合わせて
　４）右クリックして
　５）右クリックメニューを取得して
　６）右クリックメニューからプロパティ(R)を選択して
　７）プロパティ画面を取得して
　８）プロパティ画面のタブを選択して
　９）プロパティ画面を閉じる

番号をソースにも埋め込んでおきましたので参考まで

参照設定

参照設定が必要です。
ツール -> 参照設定 から UIAutomationClient を選択してください。

サンプルソース

各種エラー処理等は行ってないので簡単に無限ループに陥ってしまいます。
また画面に表示されていないファイルを選択したり等のエラー検知もしてないので、本当ならスクロールバーを操作したりが必要。
あくまでもサンプルです..

Option Explicit

#If Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If


Public Sub main()
     Dim uia As New UIAutomationClient.CUIAutomation

     '// １）エクスプローラ起動
     Dim myDocument As String
     myDocument = Environ("USERPROFILE") & "\MyDocuments"
     Shell "explorer.exe " & myDocument, vbNormalFocus

     '// エクスプローラ取得
     Dim exp As IUIAutomationElement
     Set exp = GetMainWindowByTitle(uia, uia.GetRootElement, "ドキュメント")
Debug.Print exp.CurrentClassName
Debug.Print exp.CurrentName
Debug.Print Hex(exp.CurrentControlType)

     '// エクスプローラ確認
     If exp.CurrentClassName <> "CabinetWClass" Then
         Debug.Print MsgBox("エクスプローラの起動に失敗しました", vbCritical + vbOKOnly)
         End
     End If

     '// ２）エクスプローラのファイル一覧の欄を取得
     Dim exp_list As IUIAutomationElementArray
     Set exp_list = GetElementArray(uia, exp, UIA_PropertyIds.UIA_ClassNamePropertyId, "UIItem")
Debug.Print "一覧：" & exp_list.Length & " 個"

     '// ファイル一覧を順に処理
     Dim selectItem As UIAutomationClient.IUIAutomationSelectionItemPattern
     Dim i As Long
     For i = 0 To exp_list.Length - 1
         DoEvents
Debug.Print "一覧：" & exp_list.GetElement(i).CurrentName

         '// フォーカスあてて選択
         exp_list.GetElement(i).SetFocus
         Set selectItem = exp_list.GetElement(i).GetCurrentPattern(UIA_SelectionItemPatternId)
         selectItem.Select
         Sleep 1000
     Next i

     '// ３）最初のファイルにフォーカスを当てて選択
     exp_list.GetElement(0).SetFocus
     Set selectItem = exp_list.GetElement(0).GetCurrentPattern(UIA_SelectionItemPatternId)
     selectItem.Select

     '// ４）右クリック（Shift + F10）
     SendKeys "+{F10}"

     '// ５）右クリックメニューを取得
     Dim menu As IUIAutomationElement
     Set menu = GetElement(uia, uia.GetRootElement, UIA_ClassNamePropertyId, "#32768", UIA_MenuControlTypeId)
Debug.Print menu.CurrentClassName

     '// 右クリックのメニュー列挙
     Dim menuItemArray As IUIAutomationElementArray
     Set menuItemArray = GetElementArray(uia, menu, UIA_ControlTypePropertyId, UIA_MenuItemControlTypeId)
     For i = 0 To menuItemArray.Length - 1
         DoEvents
Debug.Print "右クリックメニュー：" & menuItemArray.GetElement(i).CurrentName
         menuItemArray.GetElement(i).SetFocus
         Sleep 100
     Next i

     '// ６）右クリックメニューの プロパティ(R) を取得
     Dim menuItem As IUIAutomationElement
     Set menuItem = GetElement(uia, menu, UIA_NamePropertyId, "プロパティ(R)", UIA_MenuItemControlTypeId)
Debug.Print "右クリック：" & menuItem.CurrentName

     '// プロパティ(R) を選択（実行）
     Dim menuItemInvoke As IUIAutomationInvokePattern
     Set menuItemInvoke = menuItem.GetCurrentPattern(UIA_InvokePatternId)
     menuItemInvoke.Invoke
     DoEvents

     '// ７）プロパティ画面を取得
     Dim property As IUIAutomationElement
     Set property = GetElement(uia, uia.GetRootElement, UIA_ClassNamePropertyId, "#32770", UIA_WindowControlTypeId)
Debug.Print "プロパティ画面：" & property.CurrentName

     '// ８）プロパティ画面のタブを取得
     Dim propertyTab As IUIAutomationElementArray
     Set propertyTab = GetElementArray(uia, property, UIA_ControlTypePropertyId, UIA_TabItemControlTypeId)

     '// プロパティ画面のタブを切り替え
     For i = 0 To propertyTab.Length - 1
         DoEvents
Debug.Print "プロパティ画面：タブ：" & propertyTab.GetElement(i).CurrentName
         propertyTab.GetElement(i).SetFocus
         Sleep 1000
     Next i

     '// ９）プロパティ画面のOKボタンを取得
     Dim buttonOK As IUIAutomationElement
     Set buttonOK = GetElement(uia, property, UIA_NamePropertyId, "OK", UIA_ButtonControlTypeId)
Debug.Print "プロパティ画面：ボタン：" & buttonOK.CurrentName
     buttonOK.SetFocus

     '// プロパティ画面を閉じる（OKを押す）
     Dim buttonInvoke As IUIAutomationInvokePattern
     Set buttonInvoke = buttonOK.GetCurrentPattern(UIA_InvokePatternId)
     buttonInvoke.Invoke
     DoEvents
End Sub



'// 指定のElement を取得する
Private Function GetElement( _
     ByRef uia As CUIAutomation, _
     ByRef 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
     Dim ret As IUIAutomationElement

     '// PropertyID の Value で検索
     Set cndFirst = uia.CreatePropertyCondition(propertyId, propertyValue)

     '// ctrlType 指定があればさらに検索
     If ctrlType <> 0 Then
         Set cndSecond = uia.CreatePropertyCondition(UIA_ControlTypePropertyId, ctrlType)
         Set cndFirst = uia.CreateAndCondition(cndFirst, cndSecond)
     End If

     '// 取得できるまで繰り返し
     Do
         Sleep 100
         DoEvents
         Set ret = elmParent.FindFirst(TreeScope_Subtree, cndFirst)
     Loop Until Not ret Is Nothing

     '// 戻り値設定
     Set GetElement = ret

     '// 後始末
     Set cndFirst = Nothing
     Set cndSecond = Nothing
     Set ret = Nothing
End Function


'// 指定のElementArray を取得する
Private Function GetElementArray( _
     ByRef uia As CUIAutomation, _
     ByVal elmParent As IUIAutomationElement, _
     ByVal propertyId As Long, _
     ByVal propertyValue As Variant _
) As IUIAutomationElementArray

     Dim cnd As IUIAutomationCondition
     Dim ret As IUIAutomationElementArray

     '// PropertyID の Value で検索
     Set cnd = uia.CreatePropertyCondition(propertyId, propertyValue)

     '// 取得できるまで繰り返し
     Do
         Sleep 100
         DoEvents
         Set ret = elmParent.FindAll(TreeScope_Element Or TreeScope_Descendants Or TreeScope_Subtree, cnd)
     Loop Until Not ret Is Nothing

     '// 戻り値設定
     Set GetElementArray = ret

     '// 後始末
     Set cnd = Nothing
     Set ret = Nothing
End Function


'// 指定の子ウィンドウをタイトルから取得する
Private Function GetMainWindowByTitle( _
     ByRef uia As CUIAutomation, _
     ByRef form As IUIAutomationElement, _
     ByVal name As String _
) As IUIAutomationElement

     Dim cnd As IUIAutomationCondition
     Dim ret As IUIAutomationElement

     '// Name で検索
     Set cnd = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_NamePropertyId, name)

     '// 取得できるまで繰り返し
     Do
         Sleep 100
         DoEvents
         Set ret = form.FindFirst(TreeScope_Element Or TreeScope_Children, cnd)
     Loop Until Not ret Is Nothing

     '// 戻り値設定
     Set GetMainWindowByTitle = ret

     '// 後片付け
     Set cnd = Nothing
     Set ret = Nothing
End Function

---

参考サイトを色々見ながら勉強です..
https://social.msdn.microsoft.com/Forums/es-ES/379b8219-8acc-4f81-96f5-e4c3f81aef2f/word?forum=vbajp
https://qiita.com/callmekohei/items/487aefe1db0fd86cc7cf
https://qiita.com/mima_ita/items/3f2aa49fceca7496c587
https://www.ka-net.org/blog/?p=4855
　みなさん素晴らしいですね