Windows 10

起動中のMicrosoft EdgeからタイトルとURLを取得するVBAマクロ(DOM編)

前回の記事で、UI Automationを使って起動中のMicrosoft EdgeからタイトルとURLを取得するVBAマクロを紹介しましたが、以前書いた記事「Microsoft Edgeを操作するVBAマクロ(DOM編)」でEdgeの中にあるInternet Explorer_ServerウィンドウからHTMLDocument(JScriptTypeInfoでしたが…)を取得できることが分かっているので、こちらを使った方が楽にEdgeで開いているページの情報を取得することができます。

2015/9/29 追記:
コードに一部不具合があったので修正しました。

※ 下記コードは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 EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) 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 IsWindowVisible Lib "user32" (ByVal hWnd 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 Const SMTO_ABORTIFHUNG = &H2

Private hEdge As Long

Public Sub ListEdgeTabInfo()
'起動中のEdgeのタブからタイトルとURLを取得(64ビット版Officeでは不可)
'http://www.mvps.org/emorcillo/en/code/vb6/iedom.shtml 参照
  hEdge = 0 '初期化
  EnumWindows AddressOf EnumWindowsProc, 0
  If hEdge = 0 Then Exit Sub
  EnumChildWindows hEdge, AddressOf EnumChildProc, 0
End Sub

Private Function EnumWindowsProc(ByVal hWnd As Long, lParam As Long) As Long
  Dim buf1 As String * 255
  Dim buf2 As String * 255
  Dim ClassName As String
  Dim WindowName As String
  Dim hTmp As Long
  
  hTmp = 0 '初期化
  If IsWindowVisible(hWnd) Then
    GetClassName hWnd, buf1, Len(buf1)
    ClassName = Left(buf1, InStr(buf1, vbNullChar) - 1)
    Select Case ClassName
      Case "ApplicationFrameWindow" '非最小化時
        hTmp = FindWindowEx(hWnd, 0, "Windows.UI.Core.CoreWindow", "Microsoft Edge")
        If hTmp <> 0 Then
          hEdge = hWnd
          EnumWindowsProc = False
          Exit Function
        End If
      Case "Windows.UI.Core.CoreWindow" '最小化時
        GetWindowText hWnd, buf2, Len(buf2)
        WindowName = Left(buf2, InStr(buf2, vbNullChar) - 1)
        If WindowName = "Microsoft Edge" Then
          hEdge = hWnd
          EnumWindowsProc = False
          Exit Function
        End If
    End Select
  End If
  EnumWindowsProc = True
End Function

Private Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
  Dim buf As String * 255
  Dim ClassName As String
  Dim d As Object
  
  GetClassName hWnd, buf, Len(buf)
  ClassName = Left(buf, InStr(buf, vbNullChar) - 1)
  If ClassName = "Internet Explorer_Server" Then
    Set d = GetHTMLDocumentFromWindow(hWnd)
    If Not d Is Nothing Then
      Debug.Print d.Title, d.Location.href
    End If
  End If
  EnumChildProc = True
End Function

Private Function GetHTMLDocumentFromWindow(ByVal hWnd As Long) As Object
  Dim msg As Long
  Dim res As Long
  Dim ret As Object
  Dim d As Object
  Dim IID_IHTMLDocument As UUID
  
  Set ret = Nothing '初期化
  msg = RegisterWindowMessage("WM_HTML_GETOBJECT")
  SendMessageTimeout hWnd, 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 Set ret = d
  End If
  Set GetHTMLDocumentFromWindow = ret
End Function

上記コードでやっていることは「Microsoft Edgeを操作するVBAマクロ(DOM編)」とほぼ同じで、Internet Explorer_Serverウィンドウを探して順番にDOM操作を行っているだけです。

ただ、Edgeが最小化されている場合はApplicationFrameWindowの子ウィンドウからInternet Explorer_Serverウィンドウを取得することができなかったため、最小化時の処理は別にしています。

関連記事

起動中のMicrosoft EdgeからタイトルとURLを取得するVBAマクロ(UI Automation編)前のページ

「ファイル名を指定して実行」からMicrosoft Edgeを起動する次のページ

関連記事

  1. Windows 11

    Power Automate for desktop(Power Automate Desktop)…

    前回の記事でも触れていますが、Windows 11ではPower Au…

  2. Windows 10

    Selenium WebDriverでChromium版Edgeを操作してみました。

    先日書いた下記記事の通り、Chromium版Microsoft Edg…

  3. Office関連

    Outlookを使ってGmail送信を行うVBAマクロ

    下記G Suite アップデート ブログにある通り、今年の6月には“安…

  4. Office関連

    MicrosoftのDictateアドインを試してみました。

    Microsoftがハンズフリー入力をサポートするOffice用(Wo…

  5. Excel

    「ExcelVBAを実務で使い倒す技術」レビュー

    @ateitexeさんの下記ツイートで、高橋宣成氏が執筆された「Exc…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

最近の記事

アーカイブ

PAGE TOP