如何在VBA中重置XMLHTTP连接

Question

我正试图编程一个VBA宏来收集印度停电的数据。这个宏应该循环浏览我的excel文件中生成的几百个URL，并为每个URL创建一个XMLHTTP请求。对于每个URL，我也在检查是否有当前的数据，在不可能的情况下，我得到的是最新的数据。

基本上，每当数据不可用的时候，网站就会给出一个包含 "数据可用于以下日期 "和数据可用的日期的响应。我就用这个字符串来生成一个新的链接，链接到最新的可用数据。这样一来，一个公式就应该变成这样的链接。https:/www.watchyourpower.orgreports.php?location_id=729&from_date=12%2F04%2F2020&to_date=12%2F05%2F2020。

成这样。https:/www.watchyourpower.orgreports.php?location_id=733&from_date=13%2F05%2F2018&to_date=13%2F06%2F2018。

每次从一个URL中拉取数据是可行的，但当我试图从如上所述生成的URL中拉取数据时，我得到的只有仍然从第一个请求中缓存的字符串。我如何重置XMLHTTP请求，以便我可以使用替代的URL循环浏览我的Excel文件中生成的许多URL？我已经花了几个小时在论坛上搜索，但没有真正找到任何东西。

如果我在这里监督一些东西，对不起。我在编码方面的经验不是很丰富，我从很多不同的论坛帖子中拼凑出了我的代码，包括stackoverflow上的这两个网站。用VBA从网页中提取表格 & VBA XMLHTTP清除验证？

这是我的代码。

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

这总是导致一个

对象变量或未设置With块变量

行错误。

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

Answer 1

对于初学者来说，只是一些一般性的建议，你可以把创建和发送请求的部分变成自己的单一函数，返回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