IEのHTML要素をキーワード検索してクリックする[vbs]

yizm

5年前

前回の値設定をすこし組み替えて、要素をクリックできる関数を作ってみました。

今回のチャーミングポイントは、検索対象のタグにoptionとかaとかdivも追加して、いろんな要素をクリックできるようにしてみたところです。

検索結果がoptionタグだったときは、ClickではなくてSelected=Trueします。（普通にselectにValueセットでもできるんだけども。）

頭の関数「Sub ClickElementIE(ie, keyArgs)」以外は、前回の使い回しです。

'■ 特定キーを含むタグをクリックする。
'■ ie : 取得済みIEオブジェクト
'■ keyArgs : Valueをセットしたい対象タグに含まれるキーワードを配列で指定する。
Sub ClickElementIE(ie, keyArgs)
  Dim aryElm, ans, Elm
  Set aryElm = CreateObject("System.Collections.ArrayList")
  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
  ElseIf aryElm.Count = 1 Then
    Select Case LCase(aryElm(0).TagName)
      Case "option"
        aryElm(0).Selected = True
      Case Else
        aryElm(0).Click
    End Select
  Else
    ans = MsgBox("指定のキーワードで" & aryElm.Count & "個の要素を見つかりました。" & vbNewLine & "クリック操作は一括ではできません。", vbInformation, "vbscript - IE要素検索で多数Hit")
  End If
End Sub

'■ 子フレームも含め、IE内のすべてのDocumentから指定キーワードで要素検索 https://yizm.work/sample_code/vbscript/vbs-ie-setvalue/
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

'■ 指定キーワードリストが含まれるタグをコレクションに追加して返す。 https://yizm.work/sample_code/vbscript/vbs-ie-setvalue/
Function SerchElementsFromKeywords(doc, keyArgs, aryElm)
  Dim Elm, txtTag, keyMatch, Tags
  ' 入力系のタグを検査
  SrchTags = Array("textarea", "input", "select", "button", "option", "a", "div")
  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

'■ vbsで指定タイトル・ＵＲＬの起動中ＩＥのオブジェクトを取得 https://yizm.work/sample_code/vbscript/vbs-getie-object/
Function getObjIE(Key)
    Dim KeyWord, ie, Reg
    Set ie = Nothing
    Set Reg = CreateObject("VBScript.RegExp")
    Reg.Pattern = ".*" & Key & ".*"
    On Error Resume Next
    For Each obj In CreateObject("Shell.Application").Windows
       If TypeName(obj.Document) = "HTMLDocument" Then
            If Reg.Test(obj.LocationName) Or Reg.Test(obj.LocationURL) 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 : 取得済みIEオブジェクト

'■ keyArgs : Valueをセットしたい対象タグに含まれるキーワードを配列で指定する。

Sub ClickElementIE(ie, keyArgs)

Dim aryElm, ans, Elm

Set aryElm = CreateObject("System.Collections.ArrayList")

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

ElseIf aryElm.Count = 1 Then

Select Case LCase(aryElm(0).TagName)

Case "option"

aryElm(0).Selected = True

Case Else

aryElm(0).Click

End Select

Else

ans = MsgBox("指定のキーワードで" & aryElm.Count & "個の要素を見つかりました。" & vbNewLine & "クリック操作は一括ではできません。", vbInformation, "vbscript - IE要素検索で多数Hit")

End If

End Sub

'■ 子フレームも含め、IE内のすべてのDocumentから指定キーワードで要素検索 https://yizm.work/sample_code/vbscript/vbs-ie-setvalue/

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

On Error GoTo 0

Set CollectElementsFromKeywords = aryElm

End Function

'■ 指定キーワードリストが含まれるタグをコレクションに追加して返す。 https://yizm.work/sample_code/vbscript/vbs-ie-setvalue/

Function SerchElementsFromKeywords(doc, keyArgs, aryElm)

Dim Elm, txtTag, keyMatch, Tags

' 入力系のタグを検査

SrchTags = Array("textarea", "input", "select", "button", "option", "a", "div")

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

If keyMatch Then

aryElm.Add Elm

End If

Set SerchElementsFromKeywords = aryElm

End Function

'■ vbsで指定タイトル・ＵＲＬの起動中ＩＥのオブジェクトを取得 https://yizm.work/sample_code/vbscript/vbs-getie-object/

Function getObjIE(Key)

Dim KeyWord, ie, Reg

Set ie = Nothing

Set Reg = CreateObject("VBScript.RegExp")

Reg.Pattern = ".*" & Key & ".*"

On Error Resume Next

For Each obj In CreateObject("Shell.Application").Windows

If TypeName(obj.Document) = "HTMLDocument" Then

If Reg.Test(obj.LocationName) Or Reg.Test(obj.LocationURL) Then

Set ie = obj

End If

On Error GoTo 0

Set Reg = Nothing

If ie Is Nothing Then

MsgBox "指定のieが見つかりませんでした。"

Else

Set getObjIE = ie

End If

End Function

前回同様、こんな感じで呼び出せばいい感じにクリックしてくれます。

ClickElementIE ie, Array("button", "reset")

1	ClickElementIE ie, Array("button", "reset")