Place the following codes in a new blank module. I name this module as “MsEdge” usually. The codes in this module are no need to modify for usage. You can directly use the codes even if you don’t know much about Win API.
Public lngProcessID_Close As Long
'Part 1 --- Locate IES
Private strHwndIES As String
Private lngHwndIndex As Long
Private Declare Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" ( _
ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal 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
'Part 2 --- Get HTMLDocument from IES
Private Const SMTO_ABORTIFHUNG = &H2
Private Const GUID_IHTMLDocument2 = "{332C4425-26CB-11D0-B483-00C04FD90119}"
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, _
lParam As Any, _
ByVal fuFlags As Long, _
ByVal uTimeout As Long, _
lpdwResult 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 Any) As Long
'Part 3 --- Check Process Name
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Function findEdgeDOM(Title As String, URL As String) As Object
'Find criteria-hitting Edge page in IE mode
Dim hwndIES As Long
Do
hwndIES = enumHwndIES
If hwndIES Then
Set findEdgeDOM = getHTMLDocumentFromIES(hwndIES)
If Not findEdgeDOM Is Nothing Then
If InStr(findEdgeDOM.Title, Title) * InStr(findEdgeDOM.URL, URL) Then
Do
hwndIES = enumHwndIES
Loop While hwndIES
Exit Function
Else
Set findEdgeDOM = Nothing
End If
End If
End If
Loop While hwndIES
End Function
Public Function enumHwndIES() As Long
'Get all hwnds of IES
If Len(strHwndIES) = 0 Then
EnumWindows AddressOf EnumWindowsProc, 0
lngHwndIndex = 0
End If
'Exit function when overflow
If lngHwndIndex + 1 > (Len(strHwndIES) - Len(Replace(strHwndIES, ",", ""))) Then
enumHwndIES = 0
strHwndIES = ""
Exit Function
End If
'Return IES hwnd one by one
enumHwndIES = CLng(Split(Left(strHwndIES, Len(strHwndIES) - 1), ",")(lngHwndIndex))
lngHwndIndex = lngHwndIndex + 1
End Function
Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
Dim lngProcessID As Long
GetWindowThreadProcessId hWnd, lngProcessID
EnumChildWindows hWnd, AddressOf EnumChildProc, lngProcessID
EnumWindowsProc = True
End Function
Public Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
Dim strTargetClass As String, strClassName As String
strTargetClass = "Internet Explorer_Server"
strClassName = getClass(hWnd)
If strClassName = strTargetClass Then
If GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process WHERE ProcessId='" & lParam & "' AND Name='msedge.exe'").Count Then
strHwndIES = strHwndIES & hWnd & ","
lngProcessID_Close = lParam
EnumChildProc = False
Exit Function
End If
End If
EnumChildProc = True
End Function
Private Function getClass(hWnd As Long) As String
Dim strClassName As String
Dim lngRetLen As Long
strClassName = Space(255)
lngRetLen = GetClassName(hWnd, strClassName, Len(strClassName))
getClass = Left(strClassName, lngRetLen)
End Function
Public Function getHTMLDocumentFromIES(ByVal hWnd As Long) As Object
Dim iid(0 To 3) As Long
Dim lMsg As Long, lRes As Long
lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
SendMessageTimeout hWnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes
If lRes Then
IIDFromString StrPtr(GUID_IHTMLDocument2), iid(0)
ObjectFromLresult lRes, iid(0), 0, getHTMLDocumentFromIES
End If
End Function
Public Sub closeEdge(Title As String, URL As String)
'Close a Edge browser (the last one in EnumWindows order) with criteria-hitting webpage
lngProcessID_Close = 0
Dim findEdgeDOM As Object
Dim hwndIES As Long
Do
hwndIES = enumHwndIES
If hwndIES Then
Set findEdgeDOM = getHTMLDocumentFromIES(hwndIES)
If InStr(findEdgeDOM.Title, Title) * InStr(findEdgeDOM.URL, URL) Then
Shell "TaskKill /pid " & lngProcessID_Close
Do
hwndIES = enumHwndIES
Loop While hwndIES
Exit Sub
End If
End If
Loop While hwndIES
End Sub
Apply the functions in “MsEdge” module. There are a few application examples for you. Suggest to place and test below codes at another module:
Sub findEdgeDOM_DemoProc()
'Demo Proc : Use findEdgeDOM Function to get DOM of specific Edge webpage by Title AND URL
'Dim docHTML As MSHTML.HTMLDocument '--- Early Binding
Dim docHTML As Object '--- Late Binding
Set docHTML = findEdgeDOM("Enter Part of Webpage Title Here", "Enter Part of Webpage URL Here")
‘You can fill just one argument with either part of webpage title or URL as keyword to search for the target browser and leave another one blank (“”). If you provide both title and URL, the funcitons return DOM of the only browser that meets both criteria.
If Not docHTML Is Nothing Then Debug.Print docHTML.Title, docHTML.URL
End Sub
Sub goEdge()
'Go through every Edge webpage (opened in IE mode) and print out hwndIES, webpage Title & webpage URL
Dim hwndIES As Long
'Dim docHTML As MSHTML.HTMLDocument '--- Early Binding
Dim docHTML As Object '--- Late Binding
Do
hwndIES = enumHwndIES
If hwndIES Then
Set docHTML = getHTMLDocumentFromIES(hwndIES)
Debug.Print hwndIES, docHTML.Title, docHTML.URL
Else
Debug.Print "Procedure End"
End If
Loop While hwndIES
End Sub
Sub openEdgeByURL_DemoProc()
'Open Edge browser to specific URL
openEdgeByURL "Input Webpage URL Here"
End Sub
Public Sub openEdgeByURL(URL As String)
'Please change the path to your msedge.exe location in your PC
Shell "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe -url " & URL, vbNormalFocus
End Sub
Sub closeEdge_DemoProc()
'Close Edge browser
closeEdge "Enter Part of Webpage Title Here", "Enter Part of Webpage URL Here"
End Sub
