「Microsoft Edgeを操作するVBAマクロ(WebDriver編)」でも書いていますが、Edgeを外部から操作する方法として「WebDriver」が用意されています。
Microsoft Edge Dev Blogの記事にはC#のサンプルコードが記載されていますが、仕組みとしてはWebDriver Server(localhost)にJSONを投げれば良いだけなので、言語は何でも構いません。cURL + バッチ(DOS)でもEdgeを操作することが可能です。
そこで今回はEdgeを外部から操作するVBScriptを紹介します。
検証環境
- Windows 10 Pro x86/x64
- Microsoft Edge 20.10240.16384.0
- WebDriver 1.0
Microsoft Edgeを操作するVBScript
※ 下記コードの動作には「WebDriver」が必要となります。事前にインストールしておいてください。
Option Explicit Private http Private doc Private Const WebDriverFileName = "MicrosoftWebDriver.exe" Private Const URI = "http://localhost:17556/" Private Const CSIDL_PROGRAM_FILESX86 = 42 Set http = CreateObject("MSXML2.XMLHTTP") Set doc = CreateObject("htmlfile") Call AutomateMicrosoftEdge Public Sub AutomateMicrosoftEdge() 'Microsoft Edge Automation using WebDriver Dim proc Dim sid, eid Dim b64 Dim WebDriverFilePath 'Run the Microsoft WebDriver Server WebDriverFilePath = CreateObject("Shell.Application").Namespace(CSIDL_PROGRAM_FILESX86).Self.Path WebDriverFilePath = WebDriverFilePath & "\Microsoft Web Driver\" & WebDriverFileName If CreateObject("Scripting.FileSystemObject") _ .FileExists(WebDriverFilePath) = False Then Exit Sub If CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery _ ("Select * From Win32_Process Where Name = '" & WebDriverFileName & "'").Count < 1 Then Set proc = CreateObject("WScript.Shell").Exec(WebDriverFilePath & " --port=17556") End If sid = StartSession() If sid = "" Then Exit Sub NavigateToURL sid, "https://www.bing.com/" WScript.Sleep 1000 eid = FindElement(sid, "id", "sb_form_q") If eid = "" Then Exit Sub SendKeysElement sid, eid, "Microsoft MVP" eid = FindElement(sid, "id", "sb_form_go") If eid = "" Then Exit Sub ClickElement sid, eid WScript.Sleep 2000 b64 = TakeScreenshot(sid) If b64 = "" Then Exit Sub DecodeBase64 b64, GetScriptFolderPath() & "Screenshot.png" EndSession sid If Not proc Is Nothing Then proc.Terminate 'Terminate Microsoft WebDriver Server MsgBox "done.", vbInformation + vbSystemModal End Sub Private Function StartSession() 'return sessionId Dim ret Dim json Dim elm On Error Resume Next With http .Open "POST", URI & "session", False .send "{""desiredCapabilities"": {}, ""requiredCapabilities"": {}}" Select Case .Status Case 200 json = "(" & .responseText & ")" Set elm = doc.createElement("span") elm.setAttribute "id", "result" doc.body.appendChild elm doc.parentWindow.execScript _ "document.getElementById('result').innerText=eval(" & json & ").sessionId;" If LCase(elm.innerText) = "null" Then ret = "" Else ret = elm.innerText End If doc.RemoveChild elm End Select End With On Error GoTo 0 StartSession = ret End Function Private Sub NavigateToURL(ByVal sessionId, ByVal URL) On Error Resume Next With http .Open "POST", URI & "session/" & sessionId & "/url", False .send "{""url"": """ & URL & """}" End With On Error GoTo 0 End Sub Private Function FindElement(ByVal sessionId, ByVal using, ByVal elmValue) 'return elementId Dim ret Dim json Dim elm On Error Resume Next With http .Open "POST", URI & "session/" & sessionId & "/element", False .send "{""using"": """ & using & """, ""value"": """ & elmValue & """}" Select Case .Status Case 200 json = "(" & .responseText & ")" Set elm = doc.createElement("span") elm.setAttribute "id", "result" doc.body.appendChild elm doc.parentWindow.execScript _ "document.getElementById('result').innerText=eval(" & json & ").value.ELEMENT;" If LCase(elm.innerText) = "null" Then ret = "" Else ret = elm.innerText End If doc.RemoveChild elm End Select End With On Error GoTo 0 FindElement = ret End Function Private Sub SendKeysElement(ByVal sessionId, ByVal elementId, ByVal elmValue) On Error Resume Next With http .Open "POST", URI & "session/" & sessionId & "/element/" & elementId & "/value", False .send "{""value"":[""" & elmValue & """]}" End With On Error GoTo 0 End Sub Private Sub ClickElement(ByVal sessionId, ByVal elementId) On Error Resume Next With http .Open "POST", URI & "session/" & sessionId & "/element/" & elementId & "/click", False .send End With On Error GoTo 0 End Sub Private Function TakeScreenshot(ByVal sessionId) 'return screenshot as a base64 encoded PNG Dim ret Dim json Dim elm On Error Resume Next With http .Open "GET", URI & "session/" & sessionId & "/screenshot", False .send Select Case .Status Case 200 json = "(" & .responseText & ")" Set elm = doc.createElement("span") elm.setAttribute "id", "result" doc.body.appendChild elm doc.parentWindow.execScript _ "document.getElementById('result').innerText=eval(" & json & ").value;" If LCase(elm.innerText) = "null" Then ret = "" Else ret = elm.innerText End If doc.RemoveChild elm End Select End With On Error GoTo 0 TakeScreenshot = ret End Function Private Sub EndSession(ByVal sessionId) On Error Resume Next With http .Open "DELETE", URI & "session/" & sessionId, False .send End With On Error GoTo 0 End Sub Private Sub DecodeBase64(ByVal base64, ByVal filePath) 'decode a base64 string Dim elm Const adTypeBinary = 1 Const adSaveCreateOverWrite = 2 On Error Resume Next Set elm = CreateObject("MSXML2.DOMDocument").createElement("base64") elm.DataType = "bin.base64" elm.Text = base64 With CreateObject("ADODB.Stream") .Type = adTypeBinary .Open .Write elm.nodeTypedValue .SaveToFile filePath, adSaveCreateOverWrite .Close End With On Error GoTo 0 End Sub Private Function GetScriptFolderPath() Dim ret With CreateObject("Scripting.FileSystemObject") ret = .GetParentFolderName(WScript.ScriptFullName) End With If Right(ret, 1) <> ChrW(92) Then ret = ret & ChrW(92) GetScriptFolderPath = ret End Function
スクリプトの動作は「Microsoft Edgeを操作するVBAマクロ(WebDriver編)」とほぼ同じで、EdgeでBingを開く → 「Microsoft MVP」をキーワードにして検索実行 → 検索結果のスクリーンショットを撮る、といったことを行っています。
実際にスクリプトを実行した際の動画をアップしたので、どのような動きをするのかは下記動画をご参照ください。
上記のようにWebDriverを使うことで、化石とも言える古い技術【VBScript】からでもMicrosoft Edgeを操作できることが分かりました。ただし、効率が良いとは言えませんので、実際に業務で利用するときはSeleniumの利用をお薦めします。
関連記事
- Microsoft Edgeを操作するVBAマクロ(WebDriver編)
- //www.ka-net.org/blog/?p=6018
- PowerShellでMicrosoft Edgeを操作する
- //www.ka-net.org/blog/?p=6029
- Microsoft Edgeを操作するVBAマクロ(DOM編)
- //www.ka-net.org/blog/?p=6033
- 続・Microsoft Edgeを操作するVBAマクロ(DOM編)
- //www.ka-net.org/blog/?p=6068
- Microsoft Edgeを操作するVBScript
- //www.ka-net.org/blog/?p=6129
- 起動中のMicrosoft EdgeからタイトルとURLを取得するVBAマクロ(UI Automation編)
- //www.ka-net.org/blog/?p=6076
- 起動中のMicrosoft EdgeからタイトルとURLを取得するVBAマクロ(DOM編)
- //www.ka-net.org/blog/?p=6086
- Microsoft EdgeでWebページを開くインターネットショートカット
- //www.ka-net.org/blog/?p=6040
- Microsoft Edgeを起動するVBScript
- //www.ka-net.org/blog/?p=6048
- Microsoft Edgeでリンク先を開く
- //www.ka-net.org/blog/?p=6050
- 「ファイル名を指定して実行」からMicrosoft Edgeを起動する
- //www.ka-net.org/blog/?p=6098
この記事へのコメントはありません。