InternetExplorer Objectを利用してVBScriptで入力フォームを表示する関数です。
入力フォームの内容をプロパティの指定だけで表示する簡易版と、HTMLで自由に設定できるHTML版を作成しました。
実行するにはVB用Elements値取得関数が必要です。
'配列で指定したプロパティの値を入力フォームから取得する。
Dim strProps: strProps = Array("FIELD1", "FIELD2", "FIELD3")
Dim strVals: strVals = showInputFormLite("Input", strProps, 300, 200)
'取得結果の表示
Dim lngIu: lngIu = UBound(strVals)
Dim lngI
Dim strMsg: strMsg = ""
For lngI = 0 To lngIu
If IsArray(strVals(lngI)) Then
Dim lngJu: lngJu = UBound(strVals(lngI))
Dim lngJ
For lngJ = 0 To lngJu
strMsg = strMsg & strProps(lngI) & "='" & strVals(lngI)(lngJ) & "'" & vbCrLf
Next
Else
strMsg = strMsg & strProps(lngI) & "='" & strVals(lngI) & "'" & vbCrLf
End If
Next
WScript.echo strMsg
'============================================================
'入力フォーム表示(簡易版)
Function showInputFormLite(ByRef strTitle, ByRef strProps, ByRef lngWidth, ByRef lngHeight)
Dim lngIu: lngIu = UBound(strProps)
Dim lngI
Dim strHtml: strHtml = ""
strHtml = strHtml & "<form>"
For lngI = 0 To lngIu
strHtml = strHtml & strProps(lngI) & ": <input type='text' name='" & strProps(lngI) & "' /><br/>"
Next
strHtml = strHtml & " <input type='hidden' name='submit_flg' value='0' />"
strHtml = strHtml & " <input type='button' onclick = ""getElementsByName('submit_flg')(0).value = '1';"" value='OK' />"
strHtml = strHtml & "</form>"
showInputFormLite = showInputForm(strTitle, strHtml, strProps, lngWidth, lngHeight)
End Function
'入力フォーム表示(HTML版)
Function showInputForm(ByRef strTitle, ByRef strHtml, ByRef strProps, ByRef lngWidth, ByRef lngHeight)
'IEのインスタンスを生成
Dim objIe: Set objIe = CreateObject("InternetExplorer.Application")
With objIe
'インプットフォーム初期値設定
.Width = lngWidth
.Height = lngHeight
.ToolBar = False
.StatusBar = False
.Visible = True
.Navigate "about:blank"
'フォームが表示されるまで待機
Do While .Busy
WScript.Sleep 500
Loop
.Document.Title = strTitle
.Document.Body.InnerHtml = strHtml
'ボタン押下まで待機
On Error Resume Next
Dim blnErr: blnErr = False
Do While objIe.Busy Or (getElementsValueByName(objIe, "submit_flg") <> "1")
If Err.Number <> 0 Then
On Error GoTo 0
blnErr = True
Exit Do
End If
WScript.Sleep 500
Loop
Dim lngIu: lngIu = UBound(strProps)
Dim strVals: ReDim strVals(lngIu)
If blnErr = False Then
Dim lngI
For lngI = 0 To lngIu
strVals(lngI) = getElementsValueByName(objIe, strProps(lngI))
Next
.Quit
End If
End With
Set objIe = Nothing
showInputForm = strVals
End Function
'指定したnameのエレメントから値を取得
Function getElementsValueByName(Byref objIe, ByRef strName)
getElementsValueByName = getElementsValue(objIe.Document.GetElementsByName(strName))
End Function
0 件のコメント:
コメントを投稿