Windows 10

Microsoft Edgeを操作するVBAマクロ(WebDriver編)

Microsoft Edge Dev Blogに「Bringing automated testing to Microsoft Edge through WebDriver」といった記事がありました。

この記事によると「Microsoft WebDriver」を使えば、外部プログラムからMicrosoft Edgeを操作することができる、とのこと。

実際にSeleniumを使ってEdgeを操作するC#のサンプルコードも載っているのですが、下図を見る限りMicrosoft WebDriver ServerにJSONを渡せば良いだけで、Seleniumは必須では無さそうです。

AutomateMicrosoftEdge_01

http://blogs.windows.com/msedgedev/2015/07/23/bringing-automated-testing-to-microsoft-edge-through-webdriver/ より

となるとつまり、“Microsoft WebDriverを使えばVBAからでもEdgeを操作できる!”ということ。

これはもう試すしかない!!
さっそくやってみることにしました。

検証環境

  • Windows 10 Pro 64ビット版
  • Office 2013 32ビット版
  • Microsoft Edge 20.10240.16384.0

Microsoft WebDriverのインストール

  1. Download Microsoft WebDriver from Official Microsoft Download Center」からMicrosoftWebDriver.msiファイルをダウンロードします。
  2. 手順1.でダウンロードした MicrosoftWebDriver.msi ファイルを実行し、指示に従ってインストール作業を進めます。
  3. AutomateMicrosoftEdge_02

    AutomateMicrosoftEdge_03

    AutomateMicrosoftEdge_04

    AutomateMicrosoftEdge_05

  4. 「Completed thr Microsoft Web Driver Setup Wizard」画面が表示されたら「Finish」ボタンをクリックして作業終了です。
  5. AutomateMicrosoftEdge_06

Microsoft WebDriverのインストールが終わると、Program Files (x86)フォルダ(32ビット版の場合はProgram Filesフォルダ)に「Microsoft Web Driver」フォルダが作成され、その中に「MicrosoftWebDriver.exe」ファイルが作成されます。

Microsoft Edgeを操作するVBAマクロ

いよいよEdgeを操作するVBAコードです。
下記コードでは、

  1. Microsoft WebDriver Server(localhost)を起動します。
  2. セッションを開始します。
  3. Yahoo! JAPANにページ移動し、「@kinuasa」をキーワードに検索を行います。
  4. 検索結果のスクリーンショットを保存(Base64文字列をデコード)します。
  5. セッションを終了します。
  6. Microsoft WebDriver Serverを終了します。

といったことを行っています。
WebDriver Serverに渡すリクエストは下記Webページを参考にしました。
特にTest Driveはレスポンスも確認しやすいので、とても参考になりました。

※ 下記コードではJSONのパースにScriptControlを使用しているため、64ビット版のOfficeでは動作しません。

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub AutomateMicrosoftEdge()
'Microsoft WebDriverを使ってEdgeを操作する
  Dim sc As Object
  Dim proc As Object
  Dim json As Object, ary As Object
  Dim jstr As String
  Dim sid As Variant, eid As Variant, b64 As Variant
  Dim eval
  Dim WebDriverFilePath As String
  Const WebDriverFileName As String = "MicrosoftWebDriver.exe"
  Const URI As String = "http://localhost:17556/"
  Const CSIDL_PROGRAM_FILESX86 = 42
  
  '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)
  End If
  
  Set sc = CreateObject("ScriptControl")
  sc.Language = "JScript"
  With CreateObject("MSXML2.XMLHTTP")
    'セッション開始(sessionId取得)
    .Open "POST", URI & "session", False
    .setRequestHeader "Content-Type", "text/plain; charset=UTF-8"
    .send "{""desiredCapabilities"": {}, ""requiredCapabilities"": {}}"
    If .Status <> 200 Then GoTo Err
    jstr = "(" & .responseText & ")"
    Set json = sc.CodeObject.eval(jstr)
    sid = VBA.CallByName(json, "sessionId", VbGet)
    If IsNull(sid) = True Then GoTo Err
    
    'Yahoo! JAPANにページ移動
    .Open "POST", URI & "session/" & sid & "/url", False
    .setRequestHeader "Content-Type", "text/plain; charset=UTF-8"
    .send "{""url"": ""http://www.yahoo.co.jp/""}"
    If .Status <> 200 Then GoTo Err
    
    '検索ボックス(srchtxt)取得
    .Open "POST", URI & "session/" & sid & "/element", False
    .setRequestHeader "Content-Type", "text/plain; charset=UTF-8"
    .send "{""using"": ""id"", ""value"": ""srchtxt""}"
    If .Status <> 200 Then GoTo Err
    jstr = "(" & .responseText & ")"
    Set json = sc.CodeObject.eval(jstr)
    Set ary = VBA.CallByName(json, "value", VbGet)
    eid = VBA.CallByName(ary, "ELEMENT", VbGet)
    If IsNull(eid) = True Then GoTo Err
    
    '検索ボックスに文字列送信(Send Keys)
    .Open "POST", URI & "session/" & sid & "/element/" & eid & "/value", False
    .setRequestHeader "Content-Type", "text/plain; charset=UTF-8"
    .send "{""value"":[""@kinuasa""]}"
    If .Status <> 200 Then GoTo Err
    
    '検索ボタン(srchbtn)取得
    .Open "POST", URI & "session/" & sid & "/element", False
    .setRequestHeader "Content-Type", "text/plain; charset=UTF-8"
    .send "{""using"": ""id"", ""value"": ""srchbtn""}"
    If .Status <> 200 Then GoTo Err
    jstr = "(" & .responseText & ")"
    Set json = sc.CodeObject.eval(jstr)
    Set ary = VBA.CallByName(json, "value", VbGet)
    eid = VBA.CallByName(ary, "ELEMENT", VbGet)
    If IsNull(eid) = True Then GoTo Err
    
    '検索ボタンクリック
    .Open "POST", URI & "session/" & sid & "/element/" & eid & "/click", False
    .setRequestHeader "Content-Type", "text/plain; charset=UTF-8"
    .send
    If .Status <> 200 Then GoTo Err
    
    'スクリーンショット取得
    Sleep 3000 '表示待ち
    .Open "GET", URI & "session/" & sid & "/screenshot", False
    .setRequestHeader "Content-Type", "text/plain; charset=UTF-8"
    .send
    If .Status <> 200 Then GoTo Err
    jstr = "(" & .responseText & ")"
    Set json = sc.CodeObject.eval(jstr)
    b64 = VBA.CallByName(json, "value", VbGet)
    If IsNull(b64) = True Then GoTo Err
    DecodeBase64 b64, ActiveWorkbook.Path & "\ScreenShot.png"
    
    'セッション終了
    .Open "DELETE", URI & "session/" & sid, False
    .setRequestHeader "Content-Type", "text/plain; charset=UTF-8"
    .send
    If .Status <> 200 Then GoTo Err
  End With
  
  If Not proc Is Nothing Then proc.Terminate 'Microsoft WebDriver Server終了
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
  Exit Sub
Err:
  MsgBox "処理が失敗しました。", vbExclamation + vbSystemModal
End Sub

Private Function DecodeBase64(ByVal Base64Str As String, ByVal FilePath As String) As Long
'ファイルをBase64デコード
  Dim elm As Object
  Dim ret As Long
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
  
  ret = -1 '初期化
  On Error Resume Next
  Set elm = CreateObject("MSXML2.DOMDocument").createElement("base64")
  elm.DataType = "bin.base64"
  elm.Text = Base64Str
  With CreateObject("ADODB.Stream")
    .Type = adTypeBinary
    .Open
    .Write elm.nodeTypedValue
    .SaveToFile FilePath, adSaveCreateOverWrite
    .Close
  End With
  If Err.Number <> 0 Then ret = 0
  On Error GoTo 0
  DecodeBase64 = ret
End Function

AutomateMicrosoftEdge_07

上記コードでは、Edgeを操作するのにいちいちJSONでリクエストを投げていますが、そのうちSelenium VBAあたりがEdgeに対応してくれるのではないかと思います。
そうなれば、もうちょっとシンプルなコードでEdgeを操作できそうです。

2015/11/01 追記:
SeleniumBasic(旧Selenium VBA)がMicrosoft Edgeに対応しました。
//www.ka-net.org/blog/?p=6394

関連記事

関連記事

  1. Office関連

    「文書のスタイル」を設定するWordマクロ

    Wordのオプション画面 → 文章校正 → Word のスペル チェッ…

  2. Office関連

    文字列を指定した文字数で分割するVBA関数

    "01234567890123456789012…"というような長い文…

  3. Office関連

    Visio Onlineの機能をJavaScriptで拡張する方法

    @mokudaiさんからのバトンを引き継ぎまして、「Office 36…

  4. Office関連

    メモ帳だけでOutlook用アドインを作ってみる。

    「SharpDevelopでExcel用COMアドインを作成する方法」…

  5. Office関連

    Google TTSで文字列を読み上げるマクロ

    2012/02/09 追記:関連記事・Google翻訳…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP