从现有打开的 IE 选项卡获取数据 vba
get data from an existing open IE tab vba
我的情况如下 我有一个用户打开的网站,其中包含需要添加到 excel 的数据,我想找到一种方法,如果我有一个已经打开的 IE 选项卡,用户将能够单击用户表单上的按钮,打开的 IE 选项卡中的数据将被拉到用户表单(数据结构始终相同 URL 是动态的)
如果我自己输入 URL,下面的代码效果很好,但我需要从当前打开的选项卡中获取数据
*总是有一个选项卡并且选项卡中的元素具有相同的id名称
我需要这部分是动态的
网站 = "https://finance.yahoo.com/quote/EURUSD=X?p=EURUSD=X"
谢谢你的帮助
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
根据以上评论:
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
我的情况如下 我有一个用户打开的网站,其中包含需要添加到 excel 的数据,我想找到一种方法,如果我有一个已经打开的 IE 选项卡,用户将能够单击用户表单上的按钮,打开的 IE 选项卡中的数据将被拉到用户表单(数据结构始终相同 URL 是动态的) 如果我自己输入 URL,下面的代码效果很好,但我需要从当前打开的选项卡中获取数据 *总是有一个选项卡并且选项卡中的元素具有相同的id名称
我需要这部分是动态的 网站 = "https://finance.yahoo.com/quote/EURUSD=X?p=EURUSD=X" 谢谢你的帮助
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
根据以上评论:
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