Vincent88
Active Member
- Joined
- Mar 5, 2021
- Messages
- 382
- Office Version
- 2019
- Platform
- Windows
- Mobile
I found this code workable for my excel project and I put it in my module1. However I need help to add code to bring the IE to forefront.
VBA Code:
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As LongPtr)
#Else
Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
#End If
Public Sub Test_IE_UIAutomation()
Dim IE As InternetExplorer
Set IE = Find_and_Activate_IE_Tab_By_URL("*cnn*")
If Not IE Is Nothing Then
Debug.Print "Activated IE tab"
Debug.Print "LocationURL = "; IE.LocationURL
Debug.Print "LocationName = "; IE.LocationName
Else
Debug.Print "Not activated IE tab"
End If
End Sub
Private Function Find_and_Activate_IE_Tab_By_URL(findUrlLike As String) As InternetExplorer
'Look for an IE browser window or tab which matches the specified URL (Like operator wildcards allowed).
'If found, activate that IE tab and return it as an InternetExplorer object. Otherwise return Nothing.
'Works with multiple IE windows
Dim Shell As Shell
Dim IE As InternetExplorer
Dim i As Variant 'must be a variant to access items in Shell.Windows() array
Dim tabURL As String
Set Shell = New Shell
i = 0
Set Find_and_Activate_IE_Tab_By_URL = Nothing
While i < Shell.Windows.Count And Find_and_Activate_IE_Tab_By_URL Is Nothing
Set IE = Shell.Windows(i)
If Not IE Is Nothing Then
If TypeName(IE.Document) = "HTMLDocument" Then
If LCase(IE.LocationURL) Like LCase(findUrlLike) Then
'Found a tab or window which matches the specified URL, now activate it
tabURL = UIAutomation_Click_IE_Tab_By_URL(IE.Hwnd, findUrlLike)
If tabURL <> "" Then Set Find_and_Activate_IE_Tab_By_URL = IE
End If
End If
End If
i = i + 1
Wend
End Function
'Find and click (activate) a tab by its URL (can contain wildcards) and return its full URL from the IE address bar
'Code #13
#If VBA7 Then
Private Function UIAutomation_Click_IE_Tab_By_URL(IEhwnd As LongPtr, findUrlLike As String) As String
#Else
Private Function UIAutomation_Click_IE_Tab_By_URL(IEhwnd As Long, findUrlLike As String) As String
#End If
Dim UIauto As IUIAutomation
Dim IEwindow As IUIAutomationElement, IEtab As IUIAutomationElement
Dim IEtabs As IUIAutomationElementArray
Dim tabItemCondition As IUIAutomationCondition
Dim addressBarCondition As IUIAutomationCondition
Dim IEtabPattern As IUIAutomationLegacyIAccessiblePattern
Dim IEaddressBar As IUIAutomationElement
Dim i As Long
Dim IEaddressBarUrl As String, prevIEaddressBarUrl As String
'Create UIAutomation object
Set UIauto = New CUIAutomation
'Get Internet Explorer UIAutomation element
Set IEwindow = UIauto.ElementFromHandle(ByVal IEhwnd)
IEwindow.SetFocus 'optional - brings the IE window to the foreground
'Create condition to find a TabItemControl
Set tabItemCondition = UIauto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_TabItemControlTypeId)
'Find all tabs
Set IEtabs = IEwindow.FindAll(TreeScope_Descendants, tabItemCondition)
'Create condition to find the IE address bar. This is a control with class name "AddressDisplay Control"
Set addressBarCondition = UIauto.CreatePropertyCondition(UIA_ClassNamePropertyId, "AddressDisplay Control")
'Activate each tab until the one with the specified URL is found
UIAutomation_Click_IE_Tab_By_URL = ""
prevIEaddressBarUrl = ""
i = 0
While i < IEtabs.Length And UIAutomation_Click_IE_Tab_By_URL = ""
'Find the IE address bar
Set IEaddressBar = IEwindow.FindFirst(TreeScope_Descendants, addressBarCondition)
'Get URL from address bar
IEaddressBarUrl = IEaddressBar.GetCurrentPropertyValue(UIA_LegacyIAccessibleValuePropertyId)
'Is this the required URL?
If Not LCase(IEaddressBarUrl) Like LCase(findUrlLike) Then
'No, so activate the next tab by invoking its DoDefaultAction method (Click)
Set IEtab = IEtabs.GetElement(i)
Set IEtabPattern = IEtab.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
IEwindow.SetFocus 'optional - brings the IE window to the foreground ' Add by me
IEtabPattern.DoDefaultAction
DoEvents
'Wait until the tab is activated, indicated by the URL being different to the previous URL
Do
Set IEaddressBar = IEwindow.FindFirst(TreeScope_Descendants, addressBarCondition)
IEaddressBarUrl = IEaddressBar.GetCurrentPropertyValue(UIA_LegacyIAccessibleValuePropertyId)
DoEvents
Sleep 20
Loop Until IEaddressBarUrl <> prevIEaddressBarUrl
prevIEaddressBarUrl = IEaddressBarUrl
Else
'Yes, so return the full URL
UIAutomation_Click_IE_Tab_By_URL = IEaddressBarUrl
End If
i = i + 1
Wend
End Function