WinActorでIE表示内容(ラベル)の取得・クリック

１．IE操作ではdivとかspanタグはクリックも取得もできない？

IEの操作ライブラリに『文字列取得（IE）』はあるけど試してみたらテキストボックスの値しか取れなかった。

あと、『表の値取得（IE）』はもちろん表になってないと取れない。

今回、たまたまCSSの:before・:afterで表示遷移するフォームとspanタグの内容取得したい場面があって、できないことに気が付いたのでスクリプト実行ライブラリを作ってみた。

２．使い方

• 普通にターゲットでIE選択する。
• 操作内容は、「クリック」と「ラベル取得」が選べる。
• 対象idにはタグにidがあればそれを指定する。
• 取得結果はクリックの場合はtrue/false、ラベル取得の場合は表示内容。

ウィンドウ識別名は、フローチャート画面のウィンドウ識別ルールの設定からウィンドウタイトルを取得したものと、ウィンドウタイトルの部分を見分けてブラウザの取得を行っています。

対象idのところは、idがないタグでもカンマ区切りでタグ属税のユニークっぽいキーワードを列挙すれば対象タグを取得できる様に作ってあります。

VBSめーかーのFunction使いまわしました。

３．スクリプト

『スクリプト実行』ノードのスクリプトタグにこれを張り付ける。

この長ったらしいスクリプトは、VBSめーかーでポチポチっと生成したスクリプトです。

冒頭のWinActor関数の部分と、ちょこちょこっとオプションを手で修正しました。

スクリプト実行ノードのスクリプト

title = GetUMSWindowTitle(@ウィンドウ識別名@)
func = !操作内容|クリック,ラベル取得!
tagID = !対象id!

Set objIE = getObjIE(title)

Select Case func
  Case "クリック"
    SetUMSVariable $取得結果$ , ClickElementIE(objIE, Split(tagID, ","))
  Case "ラベル取得"
    SetUMSVariable $取得結果$ , GetValueFromIE(objIE, Split(tagID, ","))
End Select


Class clsArrayList
  Private innerItems
  
  Public Property Get Count
    Count = innerItems.Count
  End Property
  
  Public Property Get Items
    Items = innerItems.Items
  End Property
  
  Private Sub Class_Initialize
    Set innerItems = CreateObject("Scripting.Dictionary")
  End Sub
  Private Sub Class_Terminate
    Set innerItems = Nothing
  End Sub
  
  Public Function Item(ByVal idx)
    If IsNumeric(idx) Then idx = CInt(idx)
    If innerItems.Exists(idx) Then
      If IsObject(innerItems(idx)) Then
        Set Item = innerItems(idx)
      Else
        Item = innerItems(idx)
      End If
    Else
      Item = -1
    End If
  End Function
  
  Public Sub Add(ByRef Val)
    innerItems.Add UBound(innerItems.Keys) + 1, Val
  End Sub
  
  Public Sub Clear()
    innerItems.RemoveAll
  End Sub
  
  Public Function Clone()
    Dim cloneAry
    Set cloneAry = New clsArrayList
    For Each i In innerItems.Items
      cloneAry.Add i
    Next
    Set Clone = cloneAry
  End Function
  
  Public Sub Concat(ByRef Val)
    Dim i
    If TypeName(Val) = "clsArrayList" then
      For Each i In Val.Items
        innerItems.Add i
      Next
    Else
      Select Case VarType(Val)
        Case 8194, 8195, 8196, 8197, 8198, 8199, 8200, 8201, 8202, 8203, 8204
          For Each i In Val
            innerItems.Add i
          Next
        Case Else
          innerItems.Add Val
      End Select
    End If
  End Sub
  
  Public Function Contains(ByRef Obj)
    Dim Rslt, oType, itm, tmpFlg
    Rslt = False
    oType = TypeName(Obj)
    On Error Resume Next
    For Each itm In innerItems.Items
      If TypeName(itm) = oType Then
        If IsObject(itm) Then
          If itm Is Obj Then Rslt = True
        ElseIf IsArray(itm) Then
          If UBound(itm) = UBound(Obj) Then
            tmpFlg = True
            For i = 0 To UBound(i)
              If itm(i) <> Obj(i) Then tmpFlg = False
            Next
            Rslt = Rslt Or tmpFlg
          End If
        Else
          If itm = Obj Then Rslt = True
        End If
      End If
    Next
    On Error GoTo 0
    Contains = Rslt
  End Function
  
  ' 要素をフィルタして返す
  Public Function Filter(ByVal Pattern)
    Dim Reg, RegPtn, FilAry
    Set FilAry = New clsArrayList
    Set Reg = CreateObject("VBScript.RegExp")
    RegPtn = Replace(Pattern, "*", ".*")
    RegPtn = Replace(RegPtn, "?", ".")
    RegPtn = "^" & RegPtn & "$"
    Reg.Pattern = RegPtn
    For Each i In innerItems.Items
      If Reg.Test(ItemToString(i)) Then FilAry.Add i
    Next
    Set Filter = FilAry
  End Function
  
  ' 結合
  Public Function Join()
    Join = JoinSep(", ")
  End Function
  
  Public Function JoinSep(ByVal separator)
    Dim Rslt, i
    For Each i In InnerItems.Items
      If Len(Rslt) > 0 Then Rslt = Rslt & separator
      Rslt = Rslt & ItemToString(i)
    Next
    JoinSep = Rslt
  End Function
  
  ' 文字列として要素を取得
  Private Function ItemToString(ByRef itm)
    Dim bf
    Select Case TypeName(itm)
      Case "File", "Folder"
        ItemToString = "{" & TypeName(itm) & " : """ & itm.Name & """}"
      Case Else
        Select Case VarType(itm)
          Case 2, 3, 4, 5, 6, 7, 11, 12, 17
            ItemToString = itm
          Case 8
            ItemToString = itm
          Case 9
            ItemToString = "{" & TypeName(itm) & "}"
          Case 8194, 8195, 8196, 8197, 8198, 8199, 8200, 8203
            bf = ""
            For Each i In itm
              If Len(bf) > 0 Then bf = bf & ", "
              bf = bf & i
            Next
            ItemToString = "[" & bf & "]"
          Case 8201, 8202, 8204
            bf = ""
            For Each i In itm
              If Len(bf) > 0 Then bf = bf & ", "
              bf = bf & """" & i & """"
            Next
            ItemToString = "[" & bf & "]"
          Case Else
            ItemToString = "{" & TypeName(itm) & "(" & VarType(itm) & ")}"
        End Select
      
    End Select
  End Function
  
  ' ソート 昇順
  Public Sub Sort()
    Dim itms ,i ,tmpDic
    itms = innerItems.Items
    For i = 0 To UBound(itms) - 1
      Dim j
      For j = i + 1 To UBound(itms)
        If CompareTo(itms(j), itms(i)) < 0 Then
          Call swap(itms(i), itms(j))
        End If
      Next
    Next
    
    Set tmpDic = CreateObject("Scripting.Dictionary")
    For i = 0 To UBound(itms)
      tmpDic.Add i, itms(i)
    Next
    Set innerItems = tmpDic
  End Sub
  
  ' ソート 降順
  Public Sub Reverse()
    Dim itms ,i ,tmpDic
    itms = innerItems.Items
    For i = 0 To UBound(itms) - 1
      Dim j
      For j = i + 1 To UBound(itms)
        If CompareTo(itms(j), itms(i)) > 0 Then
          Call swap(itms(i), itms(j))
        End If
      Next
    Next
    
    Set tmpDic = CreateObject("Scripting.Dictionary")
    For i = 0 To UBound(itms)
      tmpDic.Add i, itms(i)
    Next
    Set innerItems = tmpDic
  End Sub
  
  ' 要素の比較
  Function CompareTo(ByRef x, ByRef y)
    Dim xType, yType, xVal, yVal
    xType = TypeName(x)
    yType = TypeName(y)
    If xType = yType Then
      If xType = "Boolean" Then
        If x = y Then
          CompareTo = 0
        ElseIf x = False And y = True Then
          CompareTo = -1
        Else
          CompareTo = 1
        End If
        
        Exit Function
      End If
      ' 型によって規定のプロパティでソートできる様に。
      If xType = "File" Or xType = "Folder" Then
        xVal = x.Name
        yVal = y.Name
      Else
        If IsObject(x) And IsObject(y) Then
          CompareTo = 0
          Exit Function
        End If
        
        xVal = x
        yVal = y
      End If
      If xVal = yVal Then
        CompareTo = 0
      ElseIf xVal < yVal Then
        CompareTo = -1
      Else
        CompareTo = 1
      End If
    Else
      ' 型の違うオブジェクトは型名でソート
      If xType = yType Then
        CompareTo = 0
      ElseIf xType < yType Then
        CompareTo = -1
      Else
        CompareTo = 1
      End If
    End If
  End Function

  ' 要素の入れ替え
  Private Sub swap(ByRef x, ByRef y)
    Dim d
    SetVariable d, x
    SetVariable x, y
    SetVariable y, d
  End Sub
  
  Private Function SetVariable(ByRef TargetVal, ByRef SrcVal)
    If IsObject(SrcVal) Then
      Set TargetVal = SrcVal
    Else
      TargetVal = SrcVal
    End If
  End Function
End Class
'■ vbsで指定タイトル・ＵＲＬの起動中ＩＥのオブジェクトを取得
Function getObjIE(KeywordTitleOrUrl)
    Dim ie
    Set ie = Nothing
    On Error Resume Next
    For Each obj In CreateObject("Shell.Application").Windows
       If TypeName(obj.Document) = "HTMLDocument" Then
            If InStr(KeywordTitleOrUrl, obj.LocationName) > 0 Or obj.LocationURL = KeywordTitleOrUrl Then
                Set ie = obj
            End If
        End If
    Next
    On Error GoTo 0
    Set Reg = Nothing
    If ie Is Nothing Then
        MsgBox "指定のieが見つかりませんでした。"
    Else
        Set getObjIE = ie
    End If
End Function
'■ 子フレームも含め、IE内のすべてのDocumentから指定キーワードで要素検索
Function CollectElementsFromKeywords(doc, keyArgs, aryElm)
  Dim url, ifrm, i
  Set aryElm = SerchElementsFromKeywords(doc, keyArgs, aryElm)
  On Error Resume Next
  Set ifrm = doc.frames
  For i = 0 To ifrm.Length -1
    If Err.Number = 0 Then
      Set aryElm = CollectElementsFromKeywords(ifrm(i).document, keyArgs, aryElm)
    End If
  Next
  On Error GoTo 0
  Set CollectElementsFromKeywords = aryElm
End Function

'■ 指定キーワードリストが含まれるタグをコレクションに追加して返す。
Function SerchElementsFromKeywords(doc, keyArgs, aryElm)
  Dim Elm, txtTag, keyMatch, Tags
  SrchTags = Array("textarea", "input", "select", "button", "option", "a", "div", "span", "ul", "li", "table", "tr", "td", "p", "pre")
  For Each SrchTag In SrchTags
    For Each Elm In doc.getElementsByTagName(SrchTag)
      txtTag = Replace(Elm.OuterHtml, Elm.InnerHtml, "")
      ' １つでも含まれないキーワードがあったらFalseにする。
      keyMatch = True
      For Each Arg In keyArgs
        If InStr(txtTag, Arg) = 0 Then
          keyMatch = False
        End If
      Next
      If keyMatch Then
        aryElm.Add Elm
      End If
    Next
  Next
  
  Set SerchElementsFromKeywords = aryElm
End Function
'■ 特定キーを含むタグをクリックする。
'■ ie : 取得済みIEオブジェクト
'■ keyArgs : Valueをセットしたい対象タグに含まれるキーワードを配列で指定する。
Function ClickElementIE(ie, keyArgs)
  Dim aryElm, ans, Elm
  If TypeName(ie) <> "IWebBrowser2" Then
    ClickElementIE = False
    Exit Function
  End If
  Set aryElm = New clsArrayList
  Set aryElm = CollectElementsFromKeywords(ie.document, keyArgs, aryElm)
  
  If aryElm.Count = 0 Then
    ans = MsgBox("指定のキーワードではHTML要素を見つけられませんでした。" & vbNewLine & "・キャンセル ⇒ スクリプトを強制終了", vbOKCancel, "vbscript - IE要素検索に失敗")
    If ans = vbCancel Then
      MsgBox "スクリプトを終了します。", vbInformation, "vbscript - ユーザ介入強制終了"
      WScript.Quit
    End If
    ClickElementIE = False
  ElseIf aryElm.Count = 1 Then
    Select Case LCase(aryElm.Item(0).TagName)
      Case "option"
        aryElm.Item(0).Selected = True
      Case Else
        aryElm.Item(0).Click
    End Select
    ClickElementIE = True
  Else
    ans = MsgBox("指定のキーワードで" & aryElm.Count & "個の要素を見つかりました。" & vbNewLine & "クリック操作は一括ではできません。", vbInformation, "vbscript - IE要素検索で多数Hit")
    ClickElementIE = False
  End If
End Function
'■ 特定キーを含むタグの値を取得する。
'■ ie : 取得済みIEオブジェクト
'■ keyArgs : Valueをセットしたい対象タグに含まれるキーワードを配列で指定する。
Function GetValueFromIE(ie, keyArgs)
  Dim aryElm, ans, Elm
  If TypeName(ie) <> "IWebBrowser2" Then
    ClickElementIE = False
    Exit Function
  End If
  Set aryElm = New clsArrayList
  Set aryElm = CollectElementsFromKeywords(ie.document, keyArgs, aryElm)
  
  If aryElm.Count = 0 Then
    ans = MsgBox("指定のキーワードではHTML要素を見つけられませんでした。" & vbNewLine & "・キャンセル ⇒ スクリプトを強制終了", vbOKCancel, "vbscript - IE要素検索に失敗")
    If ans = vbCancel Then
      MsgBox "スクリプトを終了します。", vbInformation, "vbscript - ユーザ介入強制終了"
      WScript.Quit
    End If
    GetValueFromIE = ""
  ElseIf aryElm.Count = 1 Then
    Select Case LCase(aryElm.Item(0).TagName)
      Case "select", "input"
        GetValueFromIE = aryElm.Item(0).value
      Case Else
        GetValueFromIE = aryElm.Item(0).innerText
    End Select
  Else
    Dim Rslt
    For Each Elm In aryElm.Items
      Select Case LCase(aryElm.Item(0).TagName)
        Case "select", "input"
          Rslt = Rslt & aryElm.Item(0).value & vbNewLine
        Case Else
          Rslt = Rslt & aryElm.Item(0).innerText & vbNewLine
      End Select
      GetValueFromIE = Rslt
    Next
  End If
End Function

４．備考

『スクリプト実行』ノードの備考にはこんな感じでコメントを張り付け。

ウィンドウ識別名　⇒　ターゲットボタンから操作対象IEを選択
操作内容　⇒　クリック　or ラベル取得　からお選び下さい。
対象ID　⇒　操作対象のラベルを右クリック「要素の検査」を行いid=”～”の部分を取得して指定して下さい。
取得結果　⇒　クリックの場合は成功(true)失敗(false)、ラベル取得の場合は表示内容が設定されます。

５．最後に

いろいろWinActorのTipsまとめてます。
よかったらお立ち寄り下さい。
WinActor記事まとめ