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

ホーム
Excel, Windows 10, Office関連, Word, Windows関連, PowerPoint, Microsoft Edge
Microsoft Edgeを操作するVBAマクロ(DOM編)

Excel

2015.08.11

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

2021/10/1 追記：
本記事は公開されてから大分時間が経っており内容も古くなっております。
VBAからのブラウザー操作につきましては下記記事もご参照ください。

2021.10.01

Chrome DevTools ProtocolでEdgeを操作するVBAマクロ

Microsoft Edgeの操作を自動化する際はWebDriverを使うことが多いのですが、ブラウザーのバージョンにドライバーのバージョンを合わせる必要が有り、管理に手間が掛かるのが難点です。特にVBAではドライバーの更新を自動で行ってくれる「Web...

2021.05.21

IEサポート終了でVBAマクロはどうなるの？

※下記情報は2021年5月時点の情報で、今後状況が変わっていく可能性があります。先日、Microsoftから2022年6月にInternet Explorer 11デスクトップアプリケーションのサポートが終了されるとの発表がありました。 ...

2021.05.23

IEサポート終了でVBAマクロはどうなるの？(2)

※下記情報は2021年5月時点の情報で、今後状況が変わっていく可能性があります。前回の記事でInternet Explorer 11デスクトップアプリケーションのサポート終了に伴ってVBAマクロ周りがどう変わるのか、魔界の仮面弁士さんとユスキィさんのツ...

2017/1/31 追記：
一部コードを修正した記事を公開しました。

2017.01.31

【2017年1月版】Microsoft Edgeを操作するVBAマクロ(DOM編)

2021/10/1 追記：本記事は公開されてから大分時間が経っており内容も古くなっております。 VBAからのブラウザー操作につきましては下記記事もご参照ください。「Microsoft Edge VBA 操作」こうい...

2019/6/5 追記：
SeleniumBasicを使ってMicrosoft Edgeを操作する方法についても記事を書きました。

2019.06.05

【2019年6月版】SeleniumBasicでMicrosoft Edgeを操作してみました。

2015年と2018年にSeleniumBasicを使ってMicrosoft Edgeを操作する方法について記事を書きました。 Windows 10 May 2019 Updateが公開され、Edge周りの環境が変わったので、改めて動作確...

Spy++でMicrosoft Edgeのウィンドウを眺めていて気が付いたことが一つ。

“下の方のウィンドウに「Internet Explorer_Server」クラスのウィンドウがある”

何故このウィンドウがあるのかは知りませんが、これがあるということは、よく使われる“ウィンドウハンドルを指定してHTMLDocumentを捕まえる方法”が使えるということ！？

さっそく試してみることにしました。

Microsoft Edgeを操作するVBAマクロ

※ 下記コードは64ビット版Officeでは動作しませんので、コードを書き換える必要があります。

'標準モジュール
Option Explicit

Private Type UUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type

Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As Any, ByVal wParam As Long, ppvObject As Object) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const SMTO_ABORTIFHUNG = &H2

Private hEdge As Long
Private hIES As Long

Public Sub Sample()
'Microsoft EdgeをDOM操作(64ビット版Excelでは不可)
'http://www.mvps.org/emorcillo/en/code/vb6/iedom.shtml 参照
  Dim msg As Long
  Dim res As Long
  Dim d As Object
  Dim IID_IHTMLDocument As UUID
  
  'Edge起動
  CreateObject("Shell.Application").ShellExecute "microsoft-edge:http://www.yahoo.co.jp/"
  Sleep 2000
  
  EnumChildWindows 0, AddressOf EnumChildProcEdge, 0
  If hEdge = 0 Then Exit Sub
  EnumChildWindows hEdge, AddressOf EnumChildProcIES, 0
  If hIES = 0 Then Exit Sub
  msg = RegisterWindowMessage("WM_HTML_GETOBJECT")
  SendMessageTimeout hIES, msg, 0, 0, SMTO_ABORTIFHUNG, 1000, res
  If res Then
    With IID_IHTMLDocument
      .Data1 = &H626FC520
      .Data2 = &HA41E
      .Data3 = &H11CF
      .Data4(0) = &HA7
      .Data4(1) = &H31
      .Data4(2) = &H0
      .Data4(3) = &HA0
      .Data4(4) = &HC9
      .Data4(5) = &H8
      .Data4(6) = &H26
      .Data4(7) = &H37
    End With
    If ObjectFromLresult(res, IID_IHTMLDocument, 0, d) = 0 Then
      d.getElementById("srchtxt").Value = "初心者備忘録"
      d.getElementById("srchbtn").Click
      '表示待ち
      While LCase(d.readyState) <> "complete"
        Sleep 100
        DoEvents
      Wend
      MsgBox d.Title, vbInformation + vbSystemModal
    End If
  End If
End Sub

Private Function EnumChildProcEdge(ByVal hWnd As Long, ByVal lParam As Long) As Long
  Dim buf1 As String * 255
  Dim buf2 As String * 255
  Dim ClassName As String
  Dim WindowName As String
  
  GetClassName hWnd, buf1, Len(buf1)
  ClassName = Left(buf1, InStr(buf1, vbNullChar) - 1)
  If ClassName = "ApplicationFrameWindow" Then
    GetWindowText hWnd, buf2, Len(buf2)
    WindowName = Left(buf2, InStr(buf2, vbNullChar) - 1)
    If WindowName Like "*Microsoft Edge" Then
      hEdge = hWnd
      EnumChildProcEdge = False
      Exit Function
    End If
  End If
  EnumChildProcEdge = True
End Function

Private Function EnumChildProcIES(ByVal hWnd As Long, ByVal lParam As Long) As Long
  Dim buf As String * 255
  Dim ClassName As String
  
  GetClassName hWnd, buf, Len(buf)
  ClassName = Left(buf, InStr(buf, vbNullChar) - 1)
  If ClassName = "Internet Explorer_Server" Then
    hIES = hWnd
    EnumChildProcIES = False
    Exit Function
  End If
  EnumChildProcIES = True
End Function

上記コードは、 EdgeでYahoo! JAPANを開く → 「初心者備忘録」をキーワードに検索 → 検索結果のタイトルをメッセージボックスで表示、という動作を行うものですが、確認した限りでは下図のように意図した通り動作しているようです。