MicrosoftEdgeのIEモードをVBAで操作する

Option Explicit

#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

Private Declare Function GetTopWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetParent 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 EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
Private Const GW_HWNDNEXT = &H2
Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hWnd As Long, ByVal wFlag 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 IIDFromString Lib "ole32" (lpsz As Any, lpiid As Any) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Const SMTO_ABORTIFHUNG = &H2

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 Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As Any, ByVal wParam As Long, ppvObject As Object) As Long
        
'オブジェクトの位置取得？
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Declare PtrSafe Function IUnknown_QueryService Lib "shlwapi.dll" _
    (ByVal punk As IUnknown, guidService As GUID, riid As GUID, ppvOut As IAccessible) _
        As Long

Private hIES As Long
Private IeEdge As Object
Private hWnd As Long

'EdgeをIEモードに切り替える場合に使用する
'対象ウインドウを最前面にする
Private Declare Sub SetForegroundWindow Lib "user32" (ByVal hWnd As Long)

'キーボード操作
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
                                                ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
Private Const fKEYDOWN = KEYEVENTF_EXTENDEDKEY
Private Const fKEYUP = KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP

Private Const VK_UP = &H26
Private Const VK_Alt = &H12
Private Const VK_F = &H46
Private Const VK_RETURN = &HD

Private Sub DOM取得()

    'Chromium版EdgeのIEモードをDOM操作(32ビット版Excel)
    
    Dim con As Object, items As Object
    Dim pId As Long
    Const ProcessName = "msedge.exe"

    Dim msg As Long
    Dim res As Long
    Dim IID_IHTMLDocument2 As GUID

    Dim Dom

    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 'Internet Explorer ServerのhWndをhIESに格納
                    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

    'IHTMLDocument2取得
    msg = RegisterWindowMessage("WM_HTML_GETOBJECT")
    SendMessageTimeout hIES, msg, 0, 0, SMTO_ABORTIFHUNG, 1000, res
    If res Then
        With IID_IHTMLDocument2
            .Data1 = &H332C4425
            .Data2 = &H26CB
            .Data3 = &H11D0
            .Data4(0) = &HB4
            .Data4(1) = &H83
            .Data4(2) = &H0
            .Data4(3) = &HC0
            .Data4(4) = &H4F
            .Data4(5) = &HD9
            .Data4(6) = &H1
            .Data4(7) = &H19
        End With
        
        'IeEdgeを使いたいために適当にDomという変数を宣言して左辺に
        '正しくは「If ObjectFromLresult(res, IID_IHTMLDocument2, 0, IeEdge) = 0 Then」などの使用方法が望ましい？
        
        Dom = ObjectFromLresult(res, IID_IHTMLDocument2, 0, IeEdge)
    
    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

Sub 検索実行()

    Edge起動
    
    'GoogleのページをIEモードで開いた後に実行
    DOM取得 'IEモードのEdgeのDOMをIeEdgeに格納
    
    '最前面に持ってくるとIEモードのポップアップが消える
    Call SetForegroundWindow(hWnd)
    Sleep 3000
    
    IeEdge.getElementsByName("q")(0).Value = "VBA・GAS・Pythonで業務を楽しく効率化" '検索バーに文字を入力
    Sleep 1000
    IeEdge.getElementsByName("btnG")(0).Click '検索クリック

    While LCase(IeEdge.readyState) <> "complete"
        Sleep 1000
    Wend
    
End Sub

Private Sub Edge起動()

    'EdgeでGoogleのページを開く
    CreateObject("Shell.Application").ShellExecute "microsoft-edge:https://www.google.co.jp/"
    Sleep 3000

    'Alt+F
    keybd_event VK_Alt, 0, fKEYDOWN, 0   'Altを押す
    keybd_event VK_F, 0, fKEYDOWN, 0   'fを押す
    keybd_event VK_F, 0, fKEYUP, 0   'fを離す
    keybd_event VK_Alt, 0, fKEYUP, 0   'Altを離す

    Sleep 1000

    '上5回
    Dim i
    For i = 1 To 5
        keybd_event VK_UP, 0, fKEYDOWN, 0   'UPを押す
        keybd_event VK_UP, 0, fKEYUP, 0   'UPを離す
        Sleep 100
    Next i
        
    'Enter
    keybd_event VK_RETURN, 0, fKEYDOWN, 0   'Enterを押す
    keybd_event VK_RETURN, 0, fKEYUP, 0   'Enterを離す

    Sleep 1000

    'Enter
    keybd_event VK_RETURN, 0, fKEYDOWN, 0   'Enterを押す
    keybd_event VK_RETURN, 0, fKEYUP, 0   'Enterを離す

    Sleep 3000
    
End Sub