IEモードで表示されたウィンドウから、UI Automationを使用してInternet Explorer_Serverウィンドウのハンドルを取得します。関連Tweet：https://twitter.com/kinuasa/status/1431542123073916929

GetIEServerWindowHandle.vb

'* 対象となるIEモードのタブがアクティブになっていること、ウィンドウが最小化されていないことが前提
'* HTMLDocumentの取得は弁士さんのコード( https://gist.github.com/Benshi/8442005d21e8e74bd4d3735a3e77c417 )を参照
'* 参考：弁士さんの一連のツイート( https://twitter.com/Benshi_Orator/status/1395605842888589317 )

Option Explicit

Public Sub Sample()
  Dim d As Object, h As LongPtr
  h = GetIEServerWindowHandle("yahoo.co.jp") 'IEモードで表示されているYahoo!のページが対象
  If h <> 0 Then
    Set d = GetHtmlDocument(h)
    If Not d Is Nothing Then
      Debug.Print d.location.href
    End If
  End If
End Sub

' UI Automationを使用してInternet Explorer_Serverウィンドウのハンドルを取得
'
' 第 1 引数: 対象URL(一部でも可)
Private Function GetIEServerWindowHandle(ByVal url As String) As LongPtr
  Dim uiAuto As CUIAutomation 'UIAutomationClient(UIAutomationCore.dll)参照
  Set uiAuto = New CUIAutomation
  Dim elmRoot As IUIAutomationElement
  Set elmRoot = uiAuto.GetRootElement
  Dim cndChromeWidgetWindows As IUIAutomationCondition
  Set cndChromeWidgetWindows = uiAuto.CreatePropertyCondition( _
        UIA_ClassNamePropertyId, _
        "Chrome_WidgetWin_1" _
      )
  Dim aryChromeWidgetWindows As IUIAutomationElementArray
  Set aryChromeWidgetWindows = elmRoot.FindAll(TreeScope_Children, cndChromeWidgetWindows)
  Dim cndIEServer As IUIAutomationCondition, elmIEServer As IUIAutomationElement, i As Integer
  For i = 0 To aryChromeWidgetWindows.Length - 1
    If aryChromeWidgetWindows.GetElement(i).CurrentName Like "*- Microsoft" & ChrW(&H200B) & " Edge" Then
      Set cndIEServer = uiAuto.CreatePropertyCondition( _
            UIA_ClassNamePropertyId, _
            "Internet Explorer_Server" _
          )
      Set elmIEServer = aryChromeWidgetWindows.GetElement(i).FindFirst(TreeScope_Subtree, cndIEServer)
      If Not elmIEServer Is Nothing Then
        If LCase(elmIEServer.CurrentName) Like "*" & LCase(url) & "*" Then
          GetIEServerWindowHandle = elmIEServer.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
          Exit Function
        End If
      End If
    End If
  Next
End Function

GetIEServerWindowHandle2.vb

'* Edgeウィンドウの最小化解除、IEモードのタブ選択処理追加
'* HTMLDocumentの取得は弁士さんのコード( https://gist.github.com/Benshi/8442005d21e8e74bd4d3735a3e77c417 )を参照
'* 参考：弁士さんの一連のツイート( https://twitter.com/Benshi_Orator/status/1395605842888589317 )

Option Explicit

Public Sub Sample2()
  Dim d As Object, h As LongPtr
  h = GetIEServerWindowHandle("yahoo.co.jp") 'IEモードで表示されているYahoo!のページが対象
  If h <> 0 Then
    Set d = GetHtmlDocument(h)
    If Not d Is Nothing Then
      Debug.Print d.location.href
    End If
  End If
End Sub

' UI Automationを使用してInternet Explorer_Serverウィンドウのハンドルを取得
'
' 第 1 引数: 対象URL(一部でも可)
Private Function GetIEServerWindowHandle(ByVal url As String) As LongPtr
  Dim uiAuto As CUIAutomation 'UIAutomationClient(UIAutomationCore.dll)参照
  Set uiAuto = New CUIAutomation
  Dim elmRoot As IUIAutomationElement
  Set elmRoot = uiAuto.GetRootElement
  Dim cndChromeWidgetWindows As IUIAutomationCondition
  Set cndChromeWidgetWindows = uiAuto.CreatePropertyCondition( _
        UIA_ClassNamePropertyId, _
        "Chrome_WidgetWin_1" _
      )
  Dim aryChromeWidgetWindows As IUIAutomationElementArray
  Set aryChromeWidgetWindows = elmRoot.FindAll(TreeScope_Children, cndChromeWidgetWindows)
  Dim elmChromeWidgetWindow As IUIAutomationElement
  Dim elmIEServer As IUIAutomationElement
  Dim wptn As IUIAutomationWindowPattern
  Dim i As Integer
  For i = 0 To aryChromeWidgetWindows.Length - 1
    If aryChromeWidgetWindows.GetElement(i).CurrentName Like "*- Microsoft" & ChrW(&H200B) & " Edge" Then
      Set elmChromeWidgetWindow = aryChromeWidgetWindows.GetElement(i)
      '最小化解除
      If elmChromeWidgetWindow.GetCurrentPropertyValue(UIA_WindowWindowVisualStatePropertyId) = WindowVisualState_Minimized Then
        Set wptn = elmChromeWidgetWindow.GetCurrentPattern(UIA_WindowPatternId)
        wptn.SetWindowVisualState WindowVisualState_Normal
      End If
      Set elmIEServer = GetIEServer(uiAuto, elmChromeWidgetWindow, url)
      If Not elmIEServer Is Nothing Then
        GetIEServerWindowHandle = elmIEServer.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
        Exit Function
      End If
    End If
  Next
End Function

Private Function GetIEServer(ByVal uiAuto As CUIAutomation, _
                             ByVal elmChromeWidgetWindow As IUIAutomationElement, _
                             ByVal url As String) As IUIAutomationElement
  Dim elmIEServer As IUIAutomationElement
  Set elmIEServer = GetElement(uiAuto, elmChromeWidgetWindow, UIA_ClassNamePropertyId, "Internet Explorer_Server")
  If Not elmIEServer Is Nothing Then
    If LCase(elmIEServer.CurrentName) Like "*" & LCase(url) & "*" Then
      Set GetIEServer = elmIEServer
      Exit Function
    End If
  End If
  Dim elmTabStrip As IUIAutomationElement
  Set elmTabStrip = GetElement(uiAuto, elmChromeWidgetWindow, UIA_ClassNamePropertyId, "TabStrip")
  Dim cndTabItems As IUIAutomationCondition
  Set cndTabItems = uiAuto.CreatePropertyCondition( _
        UIA_ControlTypePropertyId, _
        UIA_TabItemControlTypeId _
      )
  Dim aryTabItems As IUIAutomationElementArray
  Set aryTabItems = elmTabStrip.FindAll(TreeScope_Children, cndTabItems)
  Dim selptn As IUIAutomationSelectionItemPattern
  Dim i As Integer
  For i = 0 To aryTabItems.Length - 1
    Set selptn = aryTabItems.GetElement(i).GetCurrentPattern(UIA_SelectionItemPatternId)
    selptn.Select 'タブ選択
    Set elmIEServer = GetElement(uiAuto, elmChromeWidgetWindow, UIA_ClassNamePropertyId, "Internet Explorer_Server")
    If Not elmIEServer Is Nothing Then
      If LCase(elmIEServer.CurrentName) Like "*" & LCase(url) & "*" Then
        Set GetIEServer = elmIEServer
        Exit Function
      End If
    End If
  Next
End Function

Private Function GetElement(ByVal uiAuto As CUIAutomation, _
                            ByVal elmParent As IUIAutomationElement, _
                            ByVal propertyId As Long, _
                            ByVal propertyValue As Variant, _
                            Optional ByVal ctrlType As Long = 0, _
                            Optional ByVal scope As TreeScope = TreeScope.TreeScope_Subtree) As IUIAutomationElement
  Dim cndFirst As IUIAutomationCondition
  Set cndFirst = uiAuto.CreatePropertyCondition( _
                   propertyId, _
                   propertyValue _
                 )
  If ctrlType <> 0 Then
    Dim cndSecond As IUIAutomationCondition
    Set cndSecond = uiAuto.CreatePropertyCondition( _
                      UIA_ControlTypePropertyId, _
                      ctrlType _
                    )
    Set cndFirst = uiAuto.CreateAndCondition( _
                     cndFirst, _
                     cndSecond _
                   )
  End If
  Set GetElement = elmParent.FindFirst(scope, cndFirst)
End Function

selptn.Select 'タブ選択
という場所で、メモリ不足というエラーが出てExcelが落ちます。