Go to Qiita Advent Calendar 2024 Top
LoginSignup
3
6

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@Mrs_P

Excel VBAでUIAutomationを用いてWeb自動操作_ver.2.0

Last updated at Posted at 2024-02-04

概要

  • VBAでUIAutomationを用いて、UI要素を操作するためのソースコードです。以下の動画で使われているものです。

また、以下の動画も合わせて確認すると、わかりやすいと思います。

動作前の設定

  • 必ずVBEの参照設定でUIAutomationClientの参照を有効化してください。
    image.png

実行環境

以下の環境で動作確認をしました。

  • Windows11でのExcel 2021

注意点

  • プログラムの実行については、すべて自己責任で行ってください。実行により発生した、いかなる直接的または間接的被害について、作者はその責任を負いません。
  • テスト環境で動作確認をしてください。
  • ブラウザで使う場合は通信先のサーバーへの負荷、サイトポリシーに留意してください。
  • 静的なサイトで主に実施しているため、未知の状況によってエラーが発生する可能性があります。

コードの簡単な解説

プログラムの大まかな流れは以下のとおりです。

  1. ウインドウ名からウインドウハンドルを取得
  2. 基準となる要素を取得
  3. 実行対象の要素を取得
  4. 要素に対して何らかの操作を実行

画面の要素の調査方法

Excel VBAでUIAutomationを用いて画面の要素を調査するための記事を掲載します。RPAを実行するうえで必要ですので、ご確認ください。

要素を操作するためのコードの例_ver.2.0

動画で説明したプロシージャの一部例を掲載します。

Test関数
Option Explicit

' 要素をクリックする例
Sub TestClickAction()
    Call ManipulateUIElement("Challenge", _
                    "開始", "Button", "1st", "Nochange", _
                    "", "", _
                    "Click", "")

    Dim k As Long

    For k = 1 To 10

        ' 名前のテキストボックスをクリック
        Call ManipulateUIElement("Challenge", _
                        "名前", "Text", "1st", "Increment", _
                        "Edit", "1st", _
                        "Click", "")
        ' ワークシートの指定セルから値をコピー
        ThisWorkbook.Worksheets(1).Cells(1 + k, 2).Copy
        ' Ctrl + V キーを送信して値を貼り付け
        Call SendCustomKeys("^v")
        
        ' -------------一部省略-------------
        
    Next k
End Sub

' 要素をフォーカスしてからクリックする例
Sub TestClickAction02()
    Dim k As Long

    For k = 1 To 10

        Call ManipulateUIElement("Challenge", _
                        "名前", "Text", "1st", "Increment", _
                        "Edit", "1st", _
                        "Focus", "")
        Call ManipulateUIElement("Challenge", _
                        "名前", "Text", "1st", "Increment", _
                        "Edit", "1st", _
                        "Click", "")
        ThisWorkbook.Worksheets(1).Cells(1 + k, 2).Copy
        Call SendCustomKeys("^v")

        ' -------------一部省略-------------
    Next k
End Sub

' 画面をスクロールする例
Sub TestScroll()
    Call ManipulateUIElement("Challenge", _
                             "Challenge", "Document", "1st", "Nochange", _
                             "", "", _
                             "Scroll", "0,100")
    
End Sub

関数として利用するコード_ver.2.0

汎用的に使うコードを以下に記載します。RPAとして動作する根幹部分のコードです。

汎用関数
Option Explicit

' GetNextWindow関数の宣言
Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _
  (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr
' GetNextWindow関数は、指定されたウィンドウの次のウィンドウのハンドルを取得する関数です。

' IsWindowVisible関数の宣言
Declare PtrSafe Function IsWindowVisible Lib "user32" _
  (ByVal hwnd As LongPtr) As LongPtr
' IsWindowVisible関数は、指定されたウィンドウが可視状態かどうかを判定する関数です。

' GetWindowText関数の宣言
Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
  (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr
' GetWindowText関数は、指定されたウィンドウのテキストを取得する関数です。

' FindWindow関数の宣言
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
' FindWindow関数は、指定されたクラス名やウィンドウ名からウィンドウのハンドルを取得する関数です。

Dim hwnd As LongPtr ' ウィンドウのハンドルを保持する変数

Const GW_HWNDLAST = 1 ' 最後のウィンドウ
Const GW_HWNDNEXT = 2 ' 次のウィンドウ

Const ElemStartIndex As Long = 0 '要素配列の開始番号（要素配列の終了番号までの値を設定）
Const ElemArrayOperations As Long = 10 '要素配列からの足し引き数（探索が配列数を超えたらerr.number=5のエラーとなる。）

' マウスカーソルの位置を指定座標に移動するための関数
Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, _
                                                    ByVal y As Long) As Long

' マウスのイベントを発生させるための関数
Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
                                              Optional ByVal dx As Long = 0, _
                                              Optional ByVal dy As Long = 0, _
                                              Optional ByVal dwDate As Long = 0, _
                                              Optional ByVal dwExtraInfo As Long = 0)

' マウスイベントフラグ（マウスのボタンが押されたときおよび離されたときに使用）
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4

' ウィンドウを最前面に表示するための関数
Declare PtrSafe Sub SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr)


' ウィンドウハンドルを取得するための関数
Function getWindowHandle(ByVal PartialWindowName As String) As LongPtr
    Dim strCaption As String * 500 ' ウィンドウのテキストを保持する変数
    hwnd = FindWindow(vbNullString, vbNullString) ' 最初のウィンドウのハンドルを取得
    Dim cnt As Long ' カウンタ変数
    cnt = 0
    Dim cap As String ' ウィンドウのテキストを保持する変数
    Do
        If IsWindowVisible(hwnd) Then ' ウィンドウが可視状態かどうかを判定
            GetWindowText hwnd, strCaption, Len(strCaption) ' ウィンドウのテキストを取得
            cap = Left(strCaption, InStr(strCaption, vbNullChar) - 1) ' ヌル文字までの部分を抽出
            If InStr(cap, PartialWindowName) <> 0 Then ' ウィンドウのテキストに指定の文字列が含まれているかを判定
                getWindowHandle = hwnd ' ウィンドウのハンドルを返す
                Exit Function ' 関数を終了
            End If
        End If
        hwnd = GetNextWindow(hwnd, GW_HWNDNEXT) ' 次のウィンドウのハンドルを取得
        DoEvents ' イベントを処理
        If hwnd = GetNextWindow(hwnd, GW_HWNDLAST) And cnt = 0 Then ' 最後のウィンドウで初回の場合
            cnt = 1
        ElseIf hwnd = GetNextWindow(hwnd, GW_HWNDLAST) And cnt = 1 Then ' 最後のウィンドウで2回目の場合
            Debug.Print "ウィンドウ取得に失敗" ' デバッグウィンドウにメッセージを出力
            Application.Wait [Now()] + (1 / 86400) ' 要素取得失敗用の待機
            hwnd = FindWindow(vbNullString, vbNullString) ' 最初のウィンドウのハンドルを取得し直す
            cnt = 0 ' カウンタをリセット
        End If
    Loop
End Function

' 与えられた情報を元にUI要素を特定し、指定されたアクションを実行するコード
Function ManipulateUIElement(ByVal PartialWindowName As String, _
                              ByVal ReferenceElementName As String, ByVal ReferenceElementType As String, ByVal ReferenceElementOrder As String, ByVal PositionFromReference As String, _
                              Optional ByVal ActionElementType As String, Optional ByVal ActionElementOrder As String, _
                              Optional ByVal ActionPattern As String, Optional ByRef ProcessingValue As String)
    '---引数について---------------------------------------------------------------
    ' 第一引数：PartialWindowName:ウィンドウ名（一部）
    ' 第二引数：ReferenceElementName:基準要素名
    ' 第三引数：ReferenceElementType:基準要素のコントロールタイプ
    ' 第四引数：ReferenceElementOrder:基準条件のx番目の要素（基準要素の重複性対応）
    ' 第五引数：PositionFromReference:基準要素からの位置関係
    ' 第六引数：ActionElementType:操作要素コントロールタイプ
    ' 第七引数：ActionElementOrder:操作要素のx番目の要素（操作要素の重複性対応）
    ' 第八引数：ActionPattern:実行の型
    ' 第九引数：ProcessingValue:処理値
    '------------------------------------------------------------------------------

    ' 初めに基準要素名をデバッグ
    Debug.Print vbCrLf & "-----基準要素名：" & ReferenceElementName & "-----"

    'ManipulateUIElementの引数を数値化等するために変換
    Call ReplaceArgument(ReferenceElementType, ReferenceElementOrder, PositionFromReference, _
                         ActionElementType, ActionElementOrder)
    
    'ErrorFlag = True エラーが発生した場合、ErrorFlag = False エラーが発生しなかった場合
    Dim ErrorFlag As Boolean
    ' 基準要素の配列番号に関する変数
    Dim ReferenceElementIndex As Long
    ' ウィンドウハンドルの要素（配列）を格納する変数
    Dim aryElm As UIAutomationClient.IUIAutomationElementArray
    Dim ActionElement As UIAutomationClient.IUIAutomationElement
    Do
        'エラーフラグ初期化
        ErrorFlag = False
        
        ' ウィンドウ名（一部）からウィンドウハンドルの取得
        hwnd = getWindowHandle(PartialWindowName)
        
        '基準要素を取得
        ReferenceElementIndex = GetReferenceElement(hwnd, aryElm, ReferenceElementName, ReferenceElementType, ReferenceElementOrder, ErrorFlag)
        
        '操作要素を取得
        If ErrorFlag = False Then
            Set ActionElement = GetActionElement(ReferenceElementIndex, aryElm, _
                                                 PositionFromReference, ActionElementType, ActionElementOrder, ErrorFlag)
        Else
        End If
        
        '要素の実行
        If ErrorFlag = False Then
            Call ExecuteElement(ActionElement, ActionPattern, ProcessingValue, ErrorFlag)
        Else
        End If
        
        If ErrorFlag = True Then
            Application.Wait [Now()] + (0.5 / 86400) ' 要素取得失敗用の待機
        Else
        End If
        
        ' メモリ解放
        Set aryElm = Nothing
        Set ActionElement = Nothing
        DoEvents
    Loop While ErrorFlag = True

End Function

'引数の値を置き換える
Function ReplaceArgument(ByRef ReferenceElementType As String, ByRef ReferenceElementOrder As String, Optional ByRef PositionFromReference As String, _
                          Optional ByRef ActionElementType As String, Optional ByRef ActionElementOrder As String)
    '操作要素に関する引数は両方空白または両方値ありのみ許容
    If ActionElementType <> "" And ActionElementOrder <> "" Then
    ElseIf ActionElementType = "" And ActionElementOrder = "" Then
    Else
        Stop '操作要素の値に問題あり
    End If

    ' 基準要素のコントロールタイプを数値に置換する
    ReferenceElementType = ControlTypeToNumeric(ReferenceElementType)
    ' 操作要素のコントロールタイプを数値に置換する
    If ActionElementType <> "" Then
        ActionElementType = ControlTypeToNumeric(ActionElementType)
    ' 操作要素のコントロールタイプがNULL値の際に参照要素のコントロールタイプを挿入する
    Else
        ActionElementType = ReferenceElementType
    End If
    
    ' 基準要素の「x番目」（の要素）を数値に変換する
    ReferenceElementOrder = numExtract(ReferenceElementOrder)
    ' 操作要素の「x番目」（の要素）を数値に変換する
    ActionElementOrder = numExtract(ActionElementOrder)
    
    ' 操作要素と基準要素が同じ場合の値を設定
    If PositionFromReference = "Nochange" Then
        PositionFromReference = "1"
        ActionElementType = ReferenceElementType
    ' 操作要素が基準要素より前に出現する場合の値を設定
    ElseIf PositionFromReference = "Decrement" Then
        PositionFromReference = "2"
    ' 操作要素が基準要素より後に出現する場合の値を設定
    ElseIf PositionFromReference = "Increment" Then
        PositionFromReference = "3"
    Else
        Stop ' 設定外の値の場合
    End If
End Function

' ElementTypeの値によってコントロールの種類を返す関数
Function ControlTypeToNumeric(ByVal ElementType As String) As String

    ' コントロール型識別子の値（既定値）に変換
    Select Case ElementType
        Case "AppBar"
            ControlTypeToNumeric = 50040
        Case "Button"
            ControlTypeToNumeric = 50000
        Case "Calendar"
            ControlTypeToNumeric = 50001
        Case "CheckBox"
            ControlTypeToNumeric = 50002
        Case "ComboBox"
            ControlTypeToNumeric = 50003
        Case "Custom"
            ControlTypeToNumeric = 50025
        Case "DataGrid"
            ControlTypeToNumeric = 50028
        Case "DataItem"
            ControlTypeToNumeric = 50029
        Case "Document"
            ControlTypeToNumeric = 50030
        Case "Edit"
            ControlTypeToNumeric = 50004
        Case "Group"
            ControlTypeToNumeric = 50026
        Case "Header"
            ControlTypeToNumeric = 50034
        Case "HeaderItem"
            ControlTypeToNumeric = 50035
        Case "Hyperlink"
            ControlTypeToNumeric = 50005
        Case "Image"
            ControlTypeToNumeric = 50006
        Case "List"
            ControlTypeToNumeric = 50008
        Case "ListItem"
            ControlTypeToNumeric = 50007
        Case "MenuBar"
            ControlTypeToNumeric = 50010
        Case "Menu"
            ControlTypeToNumeric = 50009
        Case "MenuItem"
            ControlTypeToNumeric = 50011
        Case "Pane"
            ControlTypeToNumeric = 50033
        Case "ProgressBar"
            ControlTypeToNumeric = 50012
        Case "RadioButton"
            ControlTypeToNumeric = 50013
        Case "ScrollBar"
            ControlTypeToNumeric = 50014
        Case "SemanticZoom"
            ControlTypeToNumeric = 50039
        Case "Separator"
            ControlTypeToNumeric = 50038
        Case "Slider"
            ControlTypeToNumeric = 50015
        Case "Spinner"
            ControlTypeToNumeric = 50016
        Case "SplitButton"
            ControlTypeToNumeric = 50031
        Case "StatusBar"
            ControlTypeToNumeric = 50017
        Case "Tab"
            ControlTypeToNumeric = 50018
        Case "TabItem"
            ControlTypeToNumeric = 50019
        Case "Table"
            ControlTypeToNumeric = 50036
        Case "Text"
            ControlTypeToNumeric = 50020
        Case "Thumb"
            ControlTypeToNumeric = 50027
        Case "TitleBar"
            ControlTypeToNumeric = 50037
        Case "ToolBar"
            ControlTypeToNumeric = 50021
        Case "ToolTip"
            ControlTypeToNumeric = 50022
        Case "Tree"
            ControlTypeToNumeric = 50023
        Case "TreeItem"
            ControlTypeToNumeric = 50024
        Case "Window"
            ControlTypeToNumeric = 50032

        Case Else
            ' 未知のコントロールタイプの場合
            Stop
    End Select
End Function

'　数字のみ取り出す関数
Function numExtract(StringValue As String) As String
    '変数の準備
    Dim i As Integer
    Dim numText As String
    '半角英数字へ変換
    StringValue = StrConv(StringValue, vbNarrow)
    'Len で文字数が分かる ＝ 1 to 文字列（最終文字）まで For Nextで影響させる。
    For i = 1 To Len(StringValue)
        'Midで文字列を左から順にnumTextに格納
        numText = Mid(StringValue, i, 1)
        'もしnumText[0-9]に該当する場合 変数numExtractに格納していく
        If numText Like "[0-9]" Then: numExtract = numExtract & numText
    Next i
End Function

' 基準要素を取得する関数
Function GetReferenceElement(ByVal hwnd As LongPtr, ByRef aryElm As UIAutomationClient.IUIAutomationElementArray, ByVal ReferenceElementName As String, _
                              ByVal ReferenceElementType As String, ByVal ReferenceElementOrder As String, _
                              ByRef ErrorFlag As Boolean) As Long
    ' 引数について、aryElm、ErrorFlagは値を切り替えるためにbyrefとする

    ' エラーハンドリング
    On Error GoTo HandleElementError
    
    ' UIAutomation オブジェクトの作成
    Dim uiAuto As UIAutomationClient.CUIAutomation
    Set uiAuto = New UIAutomationClient.CUIAutomation

    ' UIAutomation 条件の作成
    Dim uiCnd As IUIAutomationCondition
    Set uiCnd = uiAuto.CreateTrueCondition

    Dim ElementX As UIAutomationClient.IUIAutomationElement
    
    ' ウィンドウハンドルから要素を取得
    Set ElementX = uiAuto.ElementFromHandle(ByVal hwnd)
    
    ' 要素の配列を取得　※読み込みに時間がかかる場合あり
    Set aryElm = ElementX.FindAll(TreeScope_Subtree, uiCnd)
    
    Dim i As Long
    Dim DuplicateElementCount As Long
    ' 配列内で指定された要素が何回重複しているかを数える変数
    DuplicateElementCount = 0
    
    For i = ElemStartIndex To aryElm.Length - 1
        ' 要素の名前が基準名を含み、コントロールタイプが指定されたものである場合
        If InStr(aryElm.GetElement(i).CurrentName, ReferenceElementName) <> 0 _
           And aryElm.GetElement(i).CurrentControlType = ReferenceElementType Then
            ' 名前が何番目にくるかをカウント
            DuplicateElementCount = DuplicateElementCount + 1
            If DuplicateElementCount = ReferenceElementOrder Then
                ' 基準の要素が見つかった場合はインデックスを返す
                GetReferenceElement = i
                Debug.Print "1.基準要素を取得"
                Exit Function
            End If
        End If
    Next i
    
    Debug.Print "基準要素が見つかりません"
    ErrorFlag = True
    Exit Function

HandleElementError:
    If Err.Number = -2147220991 Then
        ' 存在しなくなった要素に対してメソッドが呼び出されたため（エラーコード -2147220991）
        Debug.Print "基準要素が存在しなくなりました"
        ErrorFlag = True
    ElseIf Err.Number = -2147220992 Then
        ' 無効にされた要素に対して、 有効な要素を必要とするメソッド（ Select や Expand など）が呼び出されたため（エラーコード -2147220992）
        Debug.Print "基準要素が無効にされました"
        ErrorFlag = True
    Else
        ' その他の何らかのエラーが呼び出されたため
        Debug.Print Err.Number & ":" & Err.Description
        ErrorFlag = True
        Stop '予期せぬエラー確認用。このStopをコメントアウトすると、処理を止めずに要素の取得をやり直す。
    End If
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Function

' 操作要素を取得する関数
Function GetActionElement(ByVal ReferenceElementIndex As Long, ByVal aryElm As UIAutomationClient.IUIAutomationElementArray, _
                            ByVal PositionFromReference As String, ByVal ActionElementType As String, ByVal ActionElementOrder As String, ByRef ErrorFlag As Boolean) _
                            As UIAutomationClient.IUIAutomationElement
    ' エラーハンドリング
    On Error GoTo HandleElementError
    ' 正負（1 or -1）いずれかをとる変数
    Dim EitherPlusMinus As Integer

    ' 操作要素と基準要素が同じ場合
    If PositionFromReference = 1 Then
        Set GetActionElement = aryElm.GetElement(ReferenceElementIndex)
        Debug.Print "2.操作要素を取得（基準要素＝操作要素）"
        Exit Function
    ' 操作要素が基準要素より前に出現する場合は、負の方向へ配列番号を動かす
    ElseIf PositionFromReference = 2 Then
        EitherPlusMinus = -1
    ' 操作要素が基準要素より前に出現する場合は、正の方向へ配列番号を動かす
    ElseIf PositionFromReference = 3 Then
        EitherPlusMinus = 1
    Else
    End If
    
    Dim DuplicateElementCount As Long
    ' 配列内で指定された要素が何回重複しているかを数える変数
    DuplicateElementCount = 0

    Dim k As Long

    ' kの初期値：「基準要素の配列番号」に 1を加算または減算した値
    ' kのループ範囲：「kの初期値」に、要素配列からの足し引き数（定数：ElemArrayOperations）を演算した値まで
    ' kの増減：1または-1（EitherPlusMinus ）ずつ
    For k = ReferenceElementIndex + EitherPlusMinus To ReferenceElementIndex + (ElemArrayOperations * EitherPlusMinus) Step EitherPlusMinus
        ' 配列 aryElm の k 番目の要素の コントロールタイプ が 操作要素のコントロールタイプ と一致するか
        If aryElm.GetElement(k).CurrentControlType = ActionElementType Then
            ' 「操作要素の重複カウンター」を 1 増加させます。
            DuplicateElementCount = DuplicateElementCount + 1

            ' 「操作要素の重複カウンター」が 「操作要素のx番目（ユーザー指定の引数）」に等しい場合に処理を実行します。
            If DuplicateElementCount = ActionElementOrder Then
                ' GetActionElement に要素を設定して、関数を抜ける。
                Set GetActionElement = aryElm.GetElement(k)
                Debug.Print "2.操作要素を取得"
                Exit Function
            Else
            End If
        Else
        End If
    Next k
        Debug.Print "操作要素を見つけられません"
        ErrorFlag = True
    Exit Function

HandleElementError:
    If Err.Number = -2147220991 Then
        Debug.Print "操作要素が存在しなくなりました"
        ErrorFlag = True
    ElseIf Err.Number = -2147220992 Then
        Debug.Print "操作要素が無効にされました"
        ErrorFlag = True
    Else
        ' その他の何らかのエラーが呼び出されたため
        Debug.Print Err.Number & ":" & Err.Description
        ErrorFlag = True
        Stop '予期せぬエラー確認用。
    End If
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Function

    ' ActionElementTypeに応じて異なるアクションを実行するための関数
Function ExecuteElement(ByVal ActionElement As UIAutomationClient.IUIAutomationElement, _
                        ByVal ActionPattern As String, _
                        ByRef ProcessingValue As String, _
                        ByRef ErrorFlag As Boolean)

' ActionElementTypeに応じて異なるアクションを実行するためのSelect Case文です。
Select Case ActionPattern
    ' ActionPatternが "Invoke" の場合、InvokeActionを呼び出します。
    Case "Invoke"
        Call InvokeAction(ActionElement, ErrorFlag)

    ' ActionPatternが "Toggle" の場合、ToggleActionを呼び出します。
    Case "Toggle"
        Call ToggleAction(ActionElement, ErrorFlag)

    ' ActionPatternが "ExpandCollapse" の場合、ExpandCollapseActionを呼び出します。
    Case "ExpandCollapse"
        Call ExpandCollapseAction(ActionElement, ProcessingValue, ErrorFlag)

    ' ActionPatternが "SetValue" の場合、UISetValueActionを呼び出します。
    Case "SetValue"
        Call UISetValueAction(ActionElement, ProcessingValue, ErrorFlag)

    ' ActionPatternが "SelectionItem" の場合、SelectionItemActionを呼び出します。
    Case "SelectionItem"
        Call SelectionItemAction(ActionElement, ErrorFlag)

    ' ActionPatternが "Text" の場合、TextActionを呼び出します。
    Case "Text"
        Call TextAction(ActionElement, ProcessingValue, ErrorFlag)
    
    ' ActionPatternが "Click" の場合、ClickActionを呼び出します。
    Case "Click"
        Call ClickAction(ActionElement, ErrorFlag)

    ' ActionPatternが "Focus" の場合、FocusActionを呼び出します。
    Case "Focus"
        Call FocusAction(ActionElement, ErrorFlag)

    ' ActionPatternが "Scroll" の場合、ScrollActionを呼び出します。
    Case "Scroll"
        Call ScrollAction(ActionElement, ProcessingValue, ErrorFlag)

    ' ActionPatternが "GetValue" の場合、UIGetValueActionを呼び出します。
    Case "GetValue"
        Call UIGetValueAction(ActionElement, ProcessingValue, ErrorFlag)

    ' 上記のいずれのケースにも一致しない場合、未知の値であることを示すためにStopします。
    Case Else     ' 未知の値の場合
        Stop
End Select

End Function



' UI要素に対して何かを起動する関数
Sub InvokeAction(ByVal uiElm As UIAutomationClient.IUIAutomationElement, ByRef ErrorFlag As Boolean)
    Dim uiInvoke As IUIAutomationInvokePattern
    ' エラーハンドリング
    On Error GoTo HandleElementError
    
    Set uiInvoke = uiElm.GetCurrentPattern(UIA_InvokePatternId)
  
    uiInvoke.Invoke
    Debug.Print "3.Invokeを実行"
    ' 待機
    Application.Wait [Now()] + (0.2 / 86400)
    Exit Sub

HandleElementError:
    If Err.Number = -2147220991 Then
        Debug.Print "Invokeする要素が存在しなくなりました"
        ErrorFlag = True
    ElseIf Err.Number = -2147220992 Then
        Debug.Print "Invokeする要素が無効にされました"
        ErrorFlag = True
    Else
        ' その他の何らかのエラーが呼び出されたため
        Debug.Print Err.Number & ":" & Err.Description
        ErrorFlag = True
        Stop '予期せぬエラー確認用。
    End If
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Sub

' UI要素へ値を設定する関数
Sub UISetValueAction(ByVal uiElm As UIAutomationClient.IUIAutomationElement, ByVal ProcessingValue As String, ByRef ErrorFlag As Boolean)
    '引数：ProcessingValue: 設定する値の文字列

    Dim uiValue As IUIAutomationValuePattern
    ' エラーハンドリング
    On Error GoTo HandleElementError
    
    ' UI AutomationのValueパターンを取得する
    Set uiValue = uiElm.GetCurrentPattern(UIA_ValuePatternId)
    
    ' 取得したValueパターンに値を設定する
    uiValue.SetValue ProcessingValue
    Debug.Print "3.SetValueを実行"
    ' 待機
    Application.Wait [Now()] + (0.1 / 86400)
    Exit Sub

HandleElementError:
    If Err.Number = -2147220991 Then
        Debug.Print "SetValueする要素が存在しなくなりました"
        ErrorFlag = True
    ElseIf Err.Number = -2147220992 Then
        Debug.Print "SetValueする要素が無効にされました"
        ErrorFlag = True
    Else
        ' その他の何らかのエラーが呼び出されたため
        Debug.Print Err.Number & ":" & Err.Description
        ErrorFlag = True
        Stop '予期せぬエラー確認用。
    End If
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Sub

' UI要素名を取得する関数
Sub TextAction(ByVal uiElm As UIAutomationClient.IUIAutomationElement, ByRef ProcessingValue As String, ByRef ErrorFlag As Boolean)
    On Error GoTo HandleElementError
    
    ProcessingValue = uiElm.CurrentName
    Debug.Print "3.対象の要素名を取得：" & ProcessingValue
    Exit Sub

HandleElementError:
    ' その他の何らかのエラーが呼び出されたため
    Debug.Print Err.Number & ":" & Err.Description
    ErrorFlag = True
    Stop '予期せぬエラー確認用。
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Sub


' (ラジオボタンを)押すための関数
Sub SelectionItemAction(ByVal uiElm As UIAutomationClient.IUIAutomationElement, ByRef ErrorFlag As Boolean)
    Dim uiSelectionItem As IUIAutomationSelectionItemPattern
    
    On Error GoTo HandleElementError
    
    Set uiSelectionItem = uiElm.GetCurrentPattern(UIA_SelectionItemPatternId)

    uiSelectionItem.Select
    Debug.Print "3.Selectを実行"

    ' 待機
    Application.Wait [Now()] + (0.1 / 86400)
    Exit Sub

HandleElementError:
    If Err.Number = -2147220991 Then
        Debug.Print "Selectする要素が存在しなくなりました"
        ErrorFlag = True
    ElseIf Err.Number = -2147220992 Then
        Debug.Print "Selectする要素が無効にされました"
        ErrorFlag = True
    Else
        ' その他の何らかのエラーが呼び出されたため
        Debug.Print Err.Number & ":" & Err.Description
        ErrorFlag = True
        Stop '予期せぬエラー確認用。
    End If
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Sub

' ドロップダウンリストの値を選択する関数
Sub ExpandCollapseAction(ByVal uiElm As UIAutomationClient.IUIAutomationElement, ByVal ProcessingValue As String, ByRef ErrorFlag As Boolean)
    '引数：ExpansionCount: 正の数で下方向、負の数で上方向へ動かす
    On Error GoTo HandleElementError
    Dim uiExpandCollapse As IUIAutomationExpandCollapsePattern
    Dim i As Long
    ' 数字のみ半角で抜き出す
    ProcessingValue = numExtract(ProcessingValue)

    Dim ExpansionCount As Integer
    ' ProcessingValueを数値化
    ExpansionCount = Val(ProcessingValue)
    
    Set uiExpandCollapse = uiElm.GetCurrentPattern(UIA_ExpandCollapsePatternId)

    ' 要素を展開する
    uiExpandCollapse.Expand

    If ExpansionCount < 0 Then
        ' 上方向へ動かす
        ExpansionCount = ExpansionCount * (-1)
        For i = 1 To ExpansionCount
            Call SendCustomKeys("{UP}")
            Application.Wait [Now()] + (0.1 / 86400)
        Next i
    Else
        ' 下方向へ動かす
        For i = 1 To ExpansionCount
            Call SendCustomKeys("{DOWN}")
            Application.Wait [Now()] + (0.1 / 86400)
        Next i
    End If

    ' 選択を確定する
    Call SendCustomKeys("{ENTER}")
    Debug.Print "3.ExpandCollapseを実行"

    Application.Wait [Now()] + (0.1 / 86400)

    Exit Sub

HandleElementError:
    If Err.Number = -2147220991 Then
        Debug.Print "ExpandCollapseする要素が存在しなくなりました"
        ErrorFlag = True
    ElseIf Err.Number = -2147220992 Then
        Debug.Print "ExpandCollapseする要素が無効にされました"
        ErrorFlag = True
    Else
        ' その他の何らかのエラーが呼び出されたため
        Debug.Print Err.Number & ":" & Err.Description
        ErrorFlag = True
        Stop '予期せぬエラー確認用。
    End If
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Sub

' SendKeysをカスタマイズした関数
Public Sub SendCustomKeys(ByVal Keys As String, Optional ByVal Wait As Boolean = False)
    Dim w As Object
    ' WScript.Shellを使用してSendKeysを呼び出す
    
    If w Is Nothing Then
        Set w = CreateObject("WScript.Shell")
    End If
    
    ' SendKeys関数を呼び出す
    Call w.SendKeys(Keys, Wait)
End Sub



' チェックボックスを選択する関数
Sub ToggleAction(ByVal uiElm As UIAutomationClient.IUIAutomationElement, ByRef ErrorFlag As Boolean)

    Dim uiToggle As IUIAutomationTogglePattern
    
    On Error GoTo HandleElementError
    
    Set uiToggle = uiElm.GetCurrentPattern(UIA_TogglePatternId)
    
    uiToggle.Toggle
    Debug.Print "3.Toggleを実行"
    ' 待機
    Application.Wait [Now()] + (0.1 / 86400)
    Exit Sub

HandleElementError:
    If Err.Number = -2147220991 Then
        Debug.Print "Toggleする要素が存在しなくなりました"
        ErrorFlag = True
    ElseIf Err.Number = -2147220992 Then
        Debug.Print "Toggleする要素が無効にされました"
        ErrorFlag = True
    Else
        ' その他の何らかのエラーが呼び出されたため
        Debug.Print Err.Number & ":" & Err.Description
        ErrorFlag = True
        Stop '予期せぬエラー確認用。
    End If
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Sub


' UI要素に焦点を当てる関数
Sub FocusAction(ByVal uiElm As UIAutomationClient.IUIAutomationElement, ByRef ErrorFlag As Boolean)
    ' エラーハンドリング
    On Error GoTo HandleElementError
    
    ' 要素に焦点を当てる
    uiElm.SetFocus
    
    Debug.Print "3.要素に焦点を当てる"
    ' 待機
    Application.Wait [Now()] + (0.2 / 86400)
    Exit Sub

HandleElementError:
    If Err.Number = -2147220991 Then
        Debug.Print "焦点を当てる要素が存在しなくなりました"
        ErrorFlag = True
    ElseIf Err.Number = -2147220992 Then
        Debug.Print "焦点を当てる要素が無効にされました"
        ErrorFlag = True
    Else
        ' その他の何らかのエラーが呼び出されたため
        Debug.Print Err.Number & ":" & Err.Description
        ErrorFlag = True
        Stop '予期せぬエラー確認用。
    End If
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Sub

' UI要素の中心をクリックする関数
Sub ClickAction(ByVal uiElm As UIAutomationClient.IUIAutomationElement, ByRef ErrorFlag As Boolean)
    ' エラーハンドリング
    On Error GoTo HandleElementError

    Dim x As Long
    Dim y As Long
    
    ' ウィンドウを最前面に表示
    SetForegroundWindow hwnd
    ' ボタンの中心座標を取得
    With uiElm.CurrentBoundingRectangle
        x = .Left + (.Right - .Left) / 2
        y = .Top + (.bottom - .Top) / 2
    End With
    uiElm.SetFocus
    ' マウスカーソルを移動
    SetCursorPos x, y
    ' 左クリック（マウスボタンを押す）
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
    
    ' 左クリック（マウスボタンを離す）
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    Debug.Print "3.要素をクリック"
    ' 待機
    Application.Wait [Now()] + (0.2 / 86400)
    Exit Sub

HandleElementError:
    If Err.Number = -2147220991 Then
        Debug.Print "クリックする要素が存在しなくなりました"
        ErrorFlag = True
    ElseIf Err.Number = -2147220992 Then
        Debug.Print "クリックする要素が無効にされました"
        ErrorFlag = True
    Else
        ' その他の何らかのエラーが呼び出されたため
        Debug.Print Err.Number & ":" & Err.Description
        ErrorFlag = True
        Stop '予期せぬエラー確認用。
    End If
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Sub

' 画面をスクロールする関数
Sub ScrollAction(ByVal uiElm As UIAutomationClient.IUIAutomationElement, ByVal ProcessingValue As String, ByRef ErrorFlag As Boolean)
    ' エラーハンドリング
    On Error GoTo HandleElementError
    
    ' 半角カンマが一つのみ含まれているかを判定
    If InStr(1, ProcessingValue, ",") = 0 Or InStr(1, ProcessingValue, ",") <> InStrRev(ProcessingValue, ",") Then
        Debug.Print "ProcessingValueには半角カンマが一つ含まれている必要があります。"
        Stop
        End
    End If
    
    Dim UIScrollPattern As IUIAutomationScrollPattern
    ' GetCurrentPatternメソッドを使用して、ScrollPatternを変数にセット
    Set UIScrollPattern = uiElm.GetCurrentPattern(10004)
    
    ' カンマを基準に文字列を分割
    Dim numbers() As String
    numbers = Split(ProcessingValue, ",")
    numbers(0) = numExtract(numbers(0))
    numbers(1) = numExtract(numbers(1))
    
    ' 左の数字と右の数字をそれぞれ変数に格納
    Dim x As Double
    Dim y As Double
    
    ' numbers(0)が、空文字列であるかどうかを確認します。
    If numbers(0) = "" Then
        ' 空文字列の場合、現在の値を x に代入します。
        x = UIScrollPattern.CurrentHorizontalScrollPercent
    Else
        ' 空文字列でない場合、ProcessingValueの左の数字を代入します。
        x = CDbl(numbers(0))
    End If
    
    ' numbers(1)が、空文字列であるかどうかを確認します。
    If numbers(1) = "" Then
        ' 空文字列の場合、現在の値を y に代入します。
        y = UIScrollPattern.CurrentVerticalScrollPercent
    Else
        ' 空文字列でない場合、ProcessingValueの右の数字を代入します。
        y = CDbl(numbers(1))
    End If
    
    ' 横方向（x）と縦方向（y）のスクロールの割合を設定します。
    UIScrollPattern.SetScrollPercent x, y
    
    Debug.Print "3.画面をスクロール"
    ' 待機
    Application.Wait [Now()] + (0.2 / 86400)
    Exit Sub

HandleElementError:
    If Err.Number = -2147220991 Then
        Debug.Print "スクロールする要素が存在しなくなりました"
        ErrorFlag = True
    ElseIf Err.Number = -2147220992 Then
        Debug.Print "スクロールする要素が無効にされました"
        ErrorFlag = True
    Else
        ' その他の何らかのエラーが呼び出されたため
        Debug.Print Err.Number & ":" & Err.Description
        ErrorFlag = True
        Stop '予期せぬエラー確認用。
    End If
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Sub

' UI要素の値を取得する関数
Sub UIGetValueAction(ByVal uiElm As UIAutomationClient.IUIAutomationElement, ByRef ProcessingValue As String, ByRef ErrorFlag As Boolean)

    Dim uiValue As IUIAutomationValuePattern
    ' エラーハンドリング
    On Error GoTo HandleElementError
    
    ' UI AutomationのValueパターンを取得する
    Set uiValue = uiElm.GetCurrentPattern(UIA_ValuePatternId)
    
    ' 取得したValueパターンの値を代入する
    ProcessingValue = uiValue.CurrentValue
    Debug.Print "3.GetValueを実行：" & ProcessingValue
    ' 待機
    Application.Wait [Now()] + (0.1 / 86400)
    Exit Sub

HandleElementError:
    ' 何らかのエラーが呼び出されたため
    Debug.Print Err.Number & ":" & Err.Description
    ErrorFlag = True
    Stop '予期せぬエラー確認用。
    ' エラーをクリアし、エラーハンドリングを元に戻す
    Err.Clear
    On Error GoTo 0
End Sub

把握している動き

  • ウィンドウ名を間違えたときにウィンドウを取得するためにループします。
  • 基準要素が見つからないときに基準要素を取得するためにループします。
  • 操作要素が見つからないときに操作要素を取得するためにループします。
  • 重複数およびelementindexを大きい値にしすぎて、要素の配列番号が要素の範囲外を指定したとき実行が止まります。
  • 要素について特定のエラーを検知したとき、"基準要素が存在しなくなりました"、"基準要素が無効にされました"という文言がデバッグされます。（画面が読み込み中などの理由で現れます。）
  • その他のVBA上のエラーが起きたときはエラー番号と内容をデバッグして止まります。
  • 画面の要素数が多いほど読み込み時間が長くなります。

コードの修正履歴

ex ) yyyy/mm/dd : AAAAAを修正

3
6
1

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
3
6

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?