Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
IEモードで表示されたウィンドウから、UI Automationを使用してInternet Explorer_Serverウィンドウのハンドルを取得します。
'* 対象となる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
'* 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment