使 VBA 抓取的数据自动更新
Making VBA scraped Data update automatically
我成功编写了 VBA 从网页中抓取数据。
由于数据定期更新,我希望它也能在我的 Excel 文档中更新。
我得到的数据是列出的所有博彩公司的不同赔率。
我尝试了变量 HTMLRow 的 .refreshperiod .refresh 函数,但由于某些原因它不起作用
Sub Scrape()
For x = 1 To 5
Worksheets("links").Select
Worksheets("links").Activate
mystr = "https://easyodds.com/tennis/challenger/santiago-chile/928271/match-result"
mystr = Cells(x, 1)
Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim HTMLOdds As MSHTML.IHTMLElement
Dim HTMLRow As Object
Dim HTMLCell As MSHTML.IHTMLElement
Dim RowNum As Long, ColNum As Integer
XMLPage.Open "GET", mystr, False
XMLPage.send
Dim XMLResp As MSHTML.IHTMLElement
HTMLDoc.body.innerHTML = XMLPage.responseText
Set HTMLOdds = HTMLDoc.getElementById("betsTable")
Worksheets.Add
Cells.Select
Selection.NumberFormat = "0.00"
Range("A1").Value = mystr
RowNum =
Set HTMLRow = HTMLOdds.getElementsByTagName("tbody")
For Each HTMLRow In HTMLOdds.getElementsByTagName("tr")
ColNum = 1
For Each HTMLCell In HTMLRow.getElementsByTagName("Div")
Cells(RowNum, ColNum) = HTMLCell.innerText
ColNum = ColNum + 1
Next HTMLCell
RowNum = RowNum + 1
Next HTMLRow
Next x
End Sub
您可以尝试使用 Application.OnTime Now + TimeValue("01:00:00"), "YourMethodName"
调用您的方法。此示例将每小时调用一次该方法,但您必须保持文件打开。
在模块 2 中更新以下代码:
Sub Workbook_Open()
Call Module1.Scrape
End Sub
打开工作文件时会触发此代码。
在主程序的第一行更新以下代码
Sub Scrape()
Application.OnTime Now + TimeValue("0:01"), "Scrape"
它会每分钟自动执行一次代码,这里你可以根据自己的意愿更改时间间隔。即使您关闭了工作表,这也会无限循环执行。
谢谢。
我成功编写了 VBA 从网页中抓取数据。
由于数据定期更新,我希望它也能在我的 Excel 文档中更新。
我得到的数据是列出的所有博彩公司的不同赔率。
我尝试了变量 HTMLRow 的 .refreshperiod .refresh 函数,但由于某些原因它不起作用
Sub Scrape()
For x = 1 To 5
Worksheets("links").Select
Worksheets("links").Activate
mystr = "https://easyodds.com/tennis/challenger/santiago-chile/928271/match-result"
mystr = Cells(x, 1)
Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim HTMLOdds As MSHTML.IHTMLElement
Dim HTMLRow As Object
Dim HTMLCell As MSHTML.IHTMLElement
Dim RowNum As Long, ColNum As Integer
XMLPage.Open "GET", mystr, False
XMLPage.send
Dim XMLResp As MSHTML.IHTMLElement
HTMLDoc.body.innerHTML = XMLPage.responseText
Set HTMLOdds = HTMLDoc.getElementById("betsTable")
Worksheets.Add
Cells.Select
Selection.NumberFormat = "0.00"
Range("A1").Value = mystr
RowNum =
Set HTMLRow = HTMLOdds.getElementsByTagName("tbody")
For Each HTMLRow In HTMLOdds.getElementsByTagName("tr")
ColNum = 1
For Each HTMLCell In HTMLRow.getElementsByTagName("Div")
Cells(RowNum, ColNum) = HTMLCell.innerText
ColNum = ColNum + 1
Next HTMLCell
RowNum = RowNum + 1
Next HTMLRow
Next x
End Sub
您可以尝试使用 Application.OnTime Now + TimeValue("01:00:00"), "YourMethodName"
调用您的方法。此示例将每小时调用一次该方法,但您必须保持文件打开。
在模块 2 中更新以下代码:
Sub Workbook_Open()
Call Module1.Scrape
End Sub
打开工作文件时会触发此代码。 在主程序的第一行更新以下代码
Sub Scrape()
Application.OnTime Now + TimeValue("0:01"), "Scrape"
它会每分钟自动执行一次代码,这里你可以根据自己的意愿更改时间间隔。即使您关闭了工作表,这也会无限循环执行。
谢谢。