Qiita Teams that are logged in
You are not logged in to any team

Log in to Qiita Team
Community
OrganizationEventAdvent CalendarQiitadon (β)
Service
Qiita JobsQiita ZineQiita Blog
4
Help us understand the problem. What are the problem?

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

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

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

なかなか苦労しましたがエクスプローラを操作するサンプルを作ってみました。
動作は以下
 1)エクスプローラを起動して
 2)ファイルリストを取得して
 3)ファイルにカーソルを合わせて
 4)右クリックして
 5)右クリックメニューを取得して
 6)右クリックメニューからプロパティ(R)を選択して
 7)プロパティ画面を取得して
 8)プロパティ画面のタブを選択して
 9)プロパティ画面を閉じる

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

参照設定

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

サンプルソース

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


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

     '// 1)エクスプローラ起動
     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

     '// 2)エクスプローラのファイル一覧の欄を取得
     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

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

     '// 4)右クリック(Shift + F10)
     SendKeys "+{F10}"

     '// 5)右クリックメニューを取得
     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

     '// 6)右クリックメニューの プロパティ(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

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

     '// 8)プロパティ画面のタブを取得
     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

     '// 9)プロパティ画面の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
 みなさん素晴らしいですね

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
4
Help us understand the problem. What are the problem?