get data from an existing open IE tab vba-CodePudding

my situation is as follows I have a website that users open that contains data that needs to be added to excel, I want to find a way that if I have an already opened IE tab the user will be able to click a button on a user form and the data from that opened IE tab will be pulled to the user form ( the data structure is always the same the URL is dynamic) the following code works great if I put the URL myself but I need to get the data from the currently open tab *there is always one tab and the elements in the tab have the same id names

I need this part to be dynamic website = "https://finance.yahoo.com/quote/EURUSD=X?p=EURUSD=X" thank you for the help

Sub Get_Web_Data()
' TeachExcel.com

Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim price As Variant

' Website to go to.
website = "https://finance.yahoo.com/quote/EURUSD=X?p=EURUSD=X"

' Create the object that will make the webpage request.
Set request = CreateObject("MSXML2.XMLHTTP")

' Where to go and how to go there - probably don't need to change this.
request.Open "GET", website, False

' Get fresh data.
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"

' Send the request for the webpage.
request.send

' Get the webpage response data into a variable.
response = StrConv(request.responseBody, vbUnicode)

' Put the webpage into an html object to make data references easier.
html.body.innerHTML = response

' Get the price from the specified element on the page.
price = html.getElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)").Item(0).innerText

' Output the price into a message box.
MsgBox price

End Sub

CodePudding user response：

Following on from the comments above:

Sub Tester()
    Dim IE As Object, URL As String
    
    URL = "https://finance.yahoo.com/quote/EURUSD=X?p=EURUSD=Xxx"
    
    Set IE = GetIE(URL)
    If Not IE Is Nothing Then
        'work with IE
        Debug.Print IE.document.Location
    Else
        MsgBox "No open Internet Explorer with URL:" & vbLf & URL
    End If

End Sub


'get a reference to an existing IE window, given a partial URL
Function GetIE(UrlPattern As String) As Object
    Dim o As Object, sURL As String
    
    For Each o In CreateObject("Shell.Application").Windows
        sURL = ""
        On Error Resume Next  'because may not have a "document" property
        'Check the URL and if it's the one you want then
        ' assign the window object to the return value and exit the loop
        sURL = o.document.Location
        On Error GoTo 0
        If sURL Like UrlPattern Then
            Set GetIE = o
            Exit Function
        End If
    Next o
End Function