如何在 VBA 中重置 XMLHTTP 连接

Question

我正在尝试编写一个 VBA 宏来收集大量关于印度停电的数据。该宏应该在我的 excel 文件中生成的数百个 URL 中循环，并为每个创建一个 XMLHTTP 请求。对于每个 URL，我还在检查当前数据是否可用，并且在不可能的地方获取最新数据。

基本上，只要数据不可用，网站就会给出包含 "Data is available for below date" 和数据可用日期的响应。然后我使用该字符串为最新的可用数据生成一个新的 link。这样一个公式应该变成一个 link 像： https://www.watchyourpower.org/reports.php?location_id=729&from_date=12%2F04%2F2020&to_date=12%2F05%2F2020

变成类似这样的东西： https://www.watchyourpower.org/reports.php?location_id=733&from_date=13%2F05%2F2018&to_date=13%2F06%2F2018

一次从一个 URL 中提取数据是可行的，但是当我尝试从如上所述生成的 URL 中提取数据时，我只得到仍然是从第一个请求缓存。如何重置 XMLHTTP 请求以便我可以使用替代 URL / 循环遍历我的 Excel 文件中生成的大量 URL？我花了过去几个小时在论坛中搜索，但没有真正找到任何东西。

抱歉，如果我在这里监督某些事情。我在编码方面不是很有经验，并且从许多不同的论坛帖子中拼接了我的代码，包括 Whosebug 上的这两个站点： &

这是我的代码：

Public Sub DataScraper()

Dim sResponse As String, html As HTMLDocument, clipboard, xmlhttp As Object

    Set html = New HTMLDocument
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    With xmlhttp
        .Open "GET", ThisWorkbook.Sheets("Link Generator").Range("b3").Value, False
        .setRequestHeader "Cache-Control", "no-cache"
        .setRequestHeader "Pragma", "no-cache"
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With
    html.body.innerHTML = sResponse


If InStr(html.getElementsByTagName("span")(12).innerText, "Data is available for below date range") > 0 Then
Worksheets("Link Generator").Range("e3") = Right(html.getElementsByTagName("span")(12).innerText, 29)
Worksheets("Link Generator").Calculate


    Set html = New HTMLDocument
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    With xmlhttp
        .Open "GET", ThisWorkbook.Sheets("Link Generator").Range("g3").Value, False
        .setRequestHeader "Cache-Control", "no-cache"
        .setRequestHeader "Pragma", "no-cache"
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With
    html.body.innerHTML = sResponse


End If


    Sheets.Add.Name = Sheets("Link Generator").Range("a3").Value

    With html
        Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        clipboard.SetText .getElementsByTagName("table")(2).outerHTML
        clipboard.PutInClipboard
    End With

    Worksheets(Sheets("Link Generator").Range("a3").Value).Range("b4").PasteSpecial

这总是会导致

Object variable or With block variable not set

行错误：

clipboard.SetText .getElementsByTagName("table")(2).outerHTML

Answer 1

对于开始，只是一些一般性的建议，您可以在创建的地方创建位并将请求发送到它自己的 returns html 函数中，然后您可以在需要时调用它，因此您不会重复您的代码，也不会冒险使用现有对象 - 例如：

Public Function SendRequest(URL As String) As HTMLDocument
    Dim html As HTMLDocument
    Set html = New HTMLDocument
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    With xmlhttp
        .Open "GET", URL, False
        .setRequestHeader "Cache-Control", "no-cache"
        .setRequestHeader "Pragma", "no-cache"
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With
    html.body.innerHTML = sResponse
    SendRequest = html
End Function

Public Sub DataScraper()

    Dim html As HTMLDocument, clipboard, xmlhttp As Object
    Set html = SendRequest(ThisWorkbook.Sheets("Link Generator").Range("b3").Value)

    If InStr(html.getElementsByTagName("span")(12).innerText, "Data is available for below date range") > 0 Then
        Worksheets("Link Generator").Range("e3") = Right(html.getElementsByTagName("span")(12).innerText, 29)
        Worksheets("Link Generator").Calculate
        Set html = SendRequest(ThisWorkbook.Sheets("Link Generator").Range("g3").Value)
    End If

    Sheets.Add.Name = Sheets("Link Generator").Range("a3").Value

    With html
        Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        clipboard.SetText .getElementsByTagName("table")(2).outerHTML
        clipboard.PutInClipboard
    End With

    Worksheets(Sheets("Link Generator").Range("a3").Value).Range("b4").PasteSpecial
End Sub

如何在 VBA 中重置 XMLHTTP 连接

How to reset XMLHTTP connections in VBA

excel

vba

xmlhttprequest

web-crawler

serverxmlhttp