IEのHTML要素をキーワード検索してValueを設定する[vbs]

InternetExplorer のHTML要素にValueを設定するFunctionを考えてみる。

ページ要素の分析とか対象の要素に合わせたカスタマイズをページ毎に考えるのがめんどいから、これ一つあればとりあえず値の設定はできそーだろってやつを作ってみる。textarea、input、select要素への値の設定を１つのFunctionでできるように関数を組んでみました。

まずは、ざっと考えたコードを紹介。

'■ 特定キーを含むタグにValueをセットする。
'■ ie : 取得済みIEオブジェクト
'■ keyArgs : Valueをセットしたい対象タグに含まれるキーワードを配列で指定する。
'■ Value : 設定したいValue値
Sub SetValueToIE(ie, keyArgs, val)
  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
    If LCase(aryElm(0).TagName) = "textarea" Then
      aryElm(0).innerText = val
    Else
      aryElm(0).value = val
    End If
  Else
    ans = MsgBox("指定のキーワードで" & aryElm.Count & "個の要素を見つかりました。" & vbNewLine & "・Yes ⇒ 全ての要素に値を適用" & vbNewLine & "・No ⇒ 値を設定せずスキップ" & vbNewLine & "・キャンセル ⇒ スクリプトを強制終了", vbYesNoCancel, "vbscript - IE要素検索で多数Hit")
    Select Case ans
      Case vbYes
        For Each Elm In aryElm
          If Elm.TagName = "textarea" Then
            Elm.innerText = val
          Else
            Elm.value = val
          End If
        Next
      Case vbCancel
        MsgBox "スクリプトを終了します。", vbInformation, "vbscript - ユーザ介入強制終了"
        WScript.Quit
    End Select
  End If
  
End Sub

'■ 子フレームも含め、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")
  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

以下の３つの関数を作ってます。

• Sub SetValueToIE(ie, keyArgs, val)
• Function CollectElementsFromKeywords(doc, keyArgs, aryElm)
• Function SerchElementsFromKeywords(doc, keyArgs, aryElm)

やろうとしてることのメインはSetValueToIEで、ieにはCreateObjectで作ったieか、getObjIEで取得したieをセット。keyArgsには配列で値を設定したい要素のタグに含まれるキーワードを複数入れる。valには設定したい値を入れる。

ieのHTML要素はiframeタグで区切られて一発で取得できない可能性があるから、 CollectElementsFromKeywords関数を使って再帰的にiframe要素のdocumentも検索する。

で、検索対象にしたdocumentに対してSerchElementsFromKeywords関数で指定キーワードを全て含む入力系要素がないかを検査してエレメント参照を全部 取得してくるという作り。入力系要素としては、"textarea", "input", "select", "button"を対象にしている。（buttonが含まれているのは、この機能を使いまわしてClickイベント送る機能とか作る為。）

入力中のキーワードでの要素の誤検出を防ぐ為、OuterHTMLからInnerTextを置換で削除してからキーワード検査する。

で、取得したエレメントがtextareaだったらInnerText、それ以外だったらValueにvalを設定。複数検出されてたらダイアログ出して全部に設定するかキャンセルするか確認する・・・みたいな。

Set ie = getObjIE("yizm.work")
SetValueToIE ie, Array("textarea", "comment", "required"), "わんすけ"