XMLHTTP 正在从父网页中提取 HTML

Question

我正在尝试从 wunderground 中提取历史天气数据 - 最初我尝试使用标准 HTML 元素等从主网页上抓取 Web 数据。但是后来我发现如果您添加“？format = 1”到 URL，浏览器将或多或少显示一个 csv，它更容易解析成数据表......

但是，我仍在使用 IE 浏览器，如果您要提取大量数据，这可能会很慢，因此我开始研究使用 XMLHTTP 对象来帮助更快地提取数据，这就是我遇到问题的地方-正如我提到的，在 URL 的末尾添加“？format=1”会返回一个漂亮的 csv，但是当我使用 XMLHTTP 时，它会提取原始页面的 HTML 而不是 CSV！

在我看来，当 XMLHTTP 发送它的请求时，如果你愿意的话，响应会从“父”站点返回，而不是我指定的 csv……我注意到它从结束的 URL 中提取 HTML在 .html 中，就像它在 .html 处截断一样，这就是为什么响应来自 .html 页面而不是 CSV 页面的原因。所以我尝试查看 URL 协议，看看是否有办法强制 XMLHTTP 请求csv URL，但我离我的元素很远，找不到任何东西..

下面的代码-感谢您能给我的任何帮助：

Public Sub downloadWebDataToCSV(URL As String)

    Dim ADOStream As ADODB.Stream
    Dim XMLHTTP As MSXML2.XMLHTTP60

    Set XMLHTTP = New MSXML2.XMLHTTP60
    XMLHTTP.Open "GET", URL, False
    XMLHTTP.send

    If XMLHTTP.Status = 200 Then
        Set ADOStream = New ADODB.Stream
        With ADOStream
            .Open
            .Type = adTypeBinary
            .Write XMLHTTP.responseBody
            .SaveToFile "C:\datafile.csv", 2
            .Close
        End With
    End If

End Sub

如果有帮助，这里还有父 URL 和 csv URL -

主页：https://www.wunderground.com/history/airport/KDAL/2003/10/15/DailyHistory.html CSV： https://www.wunderground.com/history/airport/KDAL/2003/10/15/DailyHistory.html?format=1

提前致谢， 丝绸代码

Answer 1

您可以通过示例 URL 通过 Weather API 获取数据：

http://api.wunderground.com/api/c991975b7f4186c0/history_20031015/q/airport/KDAL.json

如您所见，URL 由三个可变部分组成：API 密钥c991975b7f4186c0、日期20031015 和位置airport/KDAL。如果您制作 XHR，则响应以 JSON 格式返回。

如何获取 API 密钥并解析 JSON 响应，您可以在 this answer 中看到。

阅读更多关于Weather API的信息。

Answer 2

我认为您需要更改返回内容的编码，然后您可以在稍微清理格式后直接写入 CSV。要更改格式，您需要设置一些请求标头。见下文。

Public Sub downloadWebDataToCSV()
    Dim URL As String: URL = "https://www.wunderground.com/history/airport/KDAL/2003/10/15/DailyHistory.html?format=1"
    Dim XMLHTTP As New MSXML2.XMLHTTP60

    With XMLHTTP
        .Open "GET", URL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko"
        .setRequestHeader "content-type", "text/html; charset=UTF-8"
        .send
    End With

    If XMLHTTP.Status = 200 Then
        Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
        Dim Fileout As Object: Set Fileout = fso.CreateTextFile("C:\users\megatron\desktop\vba.txt")
        Dim myText As String: myText = Replace(XMLHTTP.responseText, "<br />", vbCrLf)
        Fileout.Write myText
        Fileout.Close
    End If

End Sub