Windows 10

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

昨日の記事で、Microsoft Edgeを操作するVBAコードを改めて書きましたが、昨日のコードは「TabWindowClass」クラスのウィンドウを決め打ちしているので、Edgeの仕様変更により動作しなくなる可能性があります。
(VBAでEdgeを操作するのを止めれば良いだけなんですが・・・)

そこで今回はやり方を変えて、起動中のプロセスからEdgeを探し、その子ウィンドウの中から「Internet Explorer_Server」クラスのウィンドウを取得する方法を考えてみました。

'標準モジュール
Option Explicit
 
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 GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As Long, ByVal wFlag As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetTopWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function IIDFromString Lib "ole32" (lpsz As Any, lpiid As Any) 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 GW_HWNDNEXT = &H2
Private hIES As Long

Public Sub Sample_EdgeDOM2()
'Microsoft EdgeをDOM操作(64ビット版Excelではコード要変更)
'※下記ページ参照
'http://www.mvps.org/emorcillo/en/code/vb6/iedom.shtml
'http://kchon.blog111.fc2.com/blog-entry-128.html
'http://d.hatena.ne.jp/yu-hr/20100323/1269355469
'https://blogs.msdn.microsoft.com/oldnewthing/20151015-00/?p=91351
'
'※下記環境で動作確認
'Microsoft Windows 10 Pro Insider Preview バージョン:10.0.15019 ビルド 15019
'Microsoft Edge 40.15019.1000.0
'Microsoft Excel 2016 MSO (16.0.7668.7078) 32 ビット
  
  Dim con As Object, items As Object, d As Object
  Dim hWnd As Long, pid As Long
  Const ProcessName = "MicrosoftEdgeCP.exe"
  
  '初期化
  hIES = 0
  
  'Edge起動
  CreateObject("Shell.Application").ShellExecute "microsoft-edge:http://www.yahoo.co.jp/"
  Sleep 3000
  
  Set con = CreateObject("WbemScripting.SWbemLocator").ConnectServer
  hWnd = GetTopWindow(0)
  Do
    If GetParent(hWnd) = 0 Then
      'ウィンドウハンドルからプロセスIDを取得し、Edgeのウィンドウかどうかを判別する
      GetWindowThreadProcessId hWnd, pid
      Set items = con.ExecQuery("Select * From Win32_Process Where (ProcessId = '" & pid & "') And (Name = '" & ProcessName & "')")
      If items.Count > 0 Then
        'Edgeの子ウィンドウ列挙
        EnumChildWindows hWnd, AddressOf EnumChildProcIES, 0
        If hIES <> 0 Then Exit Do
      End If
    End If
    hWnd = GetNextWindow(hWnd, GW_HWNDNEXT)
  Loop While hWnd <> 0
  If hIES = 0 Then Exit Sub
  
  Set d = GetHTMLDocumentFromIES(hIES)
  If Not d Is Nothing Then
    'DOM操作
    d.getElementById("srchtxt").Value = "初心者備忘録ブログ"
    d.getElementById("srchbtn").Click
    While LCase(d.ReadyState) <> "complete"
      Sleep 100
    Wend
    MsgBox d.Title, vbInformation + vbSystemModal
  End If
End Sub

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

Private Function GetHTMLDocumentFromIES(ByVal hWnd As Long) As Object
  Dim msg As Long, res As Long
  Dim iid(0 To 3) As Long
  Dim ret As Object, obj As Object
  Const SMTO_ABORTIFHUNG = &H2
  Const IID_IHTMLDocument2 = "{332C4425-26CB-11D0-B483-00C04FD90119}"
  
  Set ret = Nothing '初期化
  msg = RegisterWindowMessage("WM_HTML_GETOBJECT")
  SendMessageTimeout hWnd, msg, 0, 0, SMTO_ABORTIFHUNG, 1000, res
  If res Then
    IIDFromString StrPtr(IID_IHTMLDocument2), iid(0)
    If ObjectFromLresult(res, iid(0), 0, obj) = 0 Then Set ret = obj
  End If
  Set GetHTMLDocumentFromIES = ret
End Function

プロセスの特定処理部分が重いのが難点ですが、この方法であれば多少Edgeの構造が変わったとしても、Internet Explorer_Serverクラスのウィンドウを持っている限り、DOM操作できるはずです。

とはいっても、何度も言っている通り上記のような方法はMicrosoftが推奨している方法では無いため、何の保証もありません。
言語問わず、Microsoft Edgeの操作を自動化したい場合は、素直に「WebDriver」を使うのが良いでしょう。

関連記事

  1. Office関連

    Web上でVBAのコードを解析するツール「Microsoft Sharepoint and VBA …

    Web上でVBAやSharePointアプリケーションのコードを解析し…

  2. アイコン一覧

    Office 365アイコン(imageMso)一覧(E)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  3. Windows関連

    キーを指定してレジストリエディターを起動するバッチファイル

    OSの設定中、レジストリの特定のキーを開いた状態でエディターを起動した…

  4. Office関連

    Internet Explorer用OneNoteアドオンを利用して指定したWebページをOneNo…

    「Evernote Webクリッパーで指定したWebページをEvern…

  5. Windows 10

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

    前回の記事で、UI Automationを使って起動中のMicroso…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP