１．IE操作ではdivとかspanタグはクリックも取得もできない？
IEの操作ライブラリに『文字列取得（IE）』はあるけど試してみたらテキストボックスの値しか取れなかった。
あと、『表の値取得（IE）』はもちろん表になってないと取れない。
今回、たまたまCSSの:before・:afterで表示遷移するフォームとspanタグの内容取得したい場面があって、できないことに気が付いたのでスクリプト実行ライブラリを作ってみた。
２．使い方
- 普通にターゲットでIE選択する。
- 操作内容は、「クリック」と「ラベル取得」が選べる。
- 対象idにはタグにidがあればそれを指定する。
- 取得結果はクリックの場合はtrue/false、ラベル取得の場合は表示内容。
ウィンドウ識別名は、フローチャート画面のウィンドウ識別ルールの
設定からウィンドウタイトルを取得したものと、ウィンドウタイトルの部分を見分けてブラウザの取得を行っています。
対象idのところは、idがないタグでもカンマ区切りでタグ属税のユニークっぽいキーワードを列挙すれば対象タグを取得できる様に作ってあります。
VBSめーかーのFunction使いまわしました。
３．スクリプト
『スクリプト実行』ノードのスクリプトタグにこれを張り付ける。
この長ったらしいスクリプトは、このページでポチポチっと生成したスクリプトです。
冒頭のWinActor関数の部分と、ちょこちょこっとオプションを手で修正しました。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 |
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)、ラベル取得の場合は表示内容が設定されます。