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"), "わんすけ"