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 件のコメント:
コメントを投稿