Option Explicit
Public lngProcessID_Close As Long
'Part 1 --- Locate IES
Private strHwndIES As String
Private lngHwndIndex 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 EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, lParam As Long) As Long
Private Declare PtrSafe Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hWndptr As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'Part 2 --- Get HTMLDocument from IES
Private Declare PtrSafe Function RegisterWindowMessage Lib "user32.dll" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare PtrSafe Function SendMessageTimeout Lib "user32.dll" Alias "SendMessageTimeoutA" (ByVal hwnd As LongPtr, ByVal msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As LongPtr) As LongPtr
Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As Long
Private Declare PtrSafe Function ObjectFromLresult Lib "oleacc.dll" (ByVal lResult As LongPtr, riid As Any, ByVal wParam As LongPtr, ppvObject As Any) As Long
'Part 3 --- Check Process Name
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
Private Const SMTO_ABORTIFHUNG = &H2
Private Const GUID_IHTMLDocument2 = "{332C4425-26CB-11D0-B483-00C04FD90119}"
Public Function findEdgeDOM(Title As String, URL As String) As Object
'Find criteria-hitting Edge page in IE mode
Dim hwndIES As LongPtr
Do
hwndIES = enumHwndIES
If hwndIES Then
Set findEdgeDOM = getHTMLDocumentFromIES(hwndIES)
If Not findEdgeDOM Is Nothing Then
If InStr(1, findEdgeDOM.Title, Title, vbTextCompare) * InStr(1, findEdgeDOM.URL, URL, vbTextCompare) 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 LongPtr
'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 LongPtr, ByVal lParam As LongPtr) As Boolean
Dim lngProcessID As Long
GetWindowThreadProcessId hwnd, lngProcessID
'Note - in accordance with the declarations of EnumChildWindows and EnumChildProc, lngProcessID is passed by reference so that VBA automatically
'passes the variable's address and dereferences it in EnumChildProc
EnumChildWindows hwnd, AddressOf EnumChildProc, lngProcessID
EnumWindowsProc = True
End Function
Public Function EnumChildProc(ByVal hwnd As LongPtr, 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 LongPtr) 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 LongPtr) As Object
Dim iid As GUID
Dim lMsg As Long, lRes As LongPtr
lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
SendMessageTimeout hwnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes
If lRes Then
IIDFromString StrPtr(GUID_IHTMLDocument2), iid
ObjectFromLresult lRes, iid, 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 LongPtr
Do
hwndIES = enumHwndIES
If hwndIES Then
Set findEdgeDOM = getHTMLDocumentFromIES(hwndIES)
If InStr(1, findEdgeDOM.Title, Title, vbTextCompare) * InStr(1, findEdgeDOM.URL, URL, vbTextCompare) Then
Shell "TaskKill /pid " & lngProcessID_Close
Do
hwndIES = enumHwndIES
Loop While hwndIES
Exit Sub
End If
End If
Loop While hwndIES
End Sub
