１．IE操作ではdivとかspanタグはクリックも取得もできない？
IEの操作ライブラリに『文字列取得（IE）』はあるけど試してみたらテキストボックスの値しか取れなかった。
あと、『表の値取得（IE）』はもちろん表になってないと取れない。
今回、たまたまCSSの:before・:afterで表示遷移するフォームとspanタグの内容取得したい場面があって、できないことに気が付いたのでスクリプト実行ライブラリを作ってみた。
２．使い方
- 普通にターゲットでIE選択する。
- 操作内容は、「クリック」と「ラベル取得」が選べる。
- 対象idにはタグにidがあればそれを指定する。
- 取得結果はクリックの場合はtrue/false、ラベル取得の場合は表示内容。
ウィンドウ識別名は、フローチャート画面のウィンドウ識別ルールの
設定からウィンドウタイトルを取得したものと、ウィンドウタイトルの部分を見分けてブラウザの取得を行っています。
対象idのところは、idがないタグでもカンマ区切りでタグ属税のユニークっぽいキーワードを列挙すれば対象タグを取得できる様に作ってあります。
VBSめーかーのFunction使いまわしました。
３．スクリプト
『スクリプト実行』ノードのスクリプトタグにこれを張り付ける。
この長ったらしいスクリプトは、このページでポチポチっと生成したスクリプトです。
冒頭の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)、ラベル取得の場合は表示内容が設定されます。