Question

我成功写了VBA来从网页上抓取数据。

由于数据定期更新，我希望它也可以在我的Excel文档中更新。

我获得的数据与列出的所有BookMakers的赔率不同。

我为变量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

Answer 1

您可以尝试使用Dim CN As Variant Dim qTable As QueryTable For Each CN In ThisWorkbook.Connections CN.Delete Next CN For Each qTable In Sheets("Property Extract 1").QueryTables qTable.Delete Next qTable'调用您的方法。此示例每小时调用一次该方法，但您必须保持文件处于打开状态。

Answer 2

在Module2中更新以下代码：

Sub Workbook_Open()
Call Module1.Scrape
End Sub

打开工作文件时会触发此代码。更新主程序第一行中的以下代码

Sub Scrape()
Application.OnTime Now + TimeValue("0:01"), "Scrape"

它将自动执行每分钟的代码，在这里您可以根据需要更改时间间隔。即使您关闭了工作表，也会在无限循环中执行。

谢谢。

使VBA自动删除数据更新

2 个答案: