检索包含 AJAX 内容的网页

Question

检索包含 AJAX 内容的网页

Roc*_*tor 1 excel vba json xmlhttprequest web-scraping

我使用 VBA 从 ASX 网站 (www.asx.com.au) 检索股票价格已经有一段时间了，但是，我的脚本不再有效，因为网站已更新，现在使用 JavaScript 来构建内容。

因此，下面显示的脚本现在返回部分而不是页面内容。

VBA（相当标准）：

With CreateObject("WINHTTP.WinHTTPRequest.5.1")
    .Open "GET", strURL, False
    .send
    http.body.innerHTML = .responseText
End With

Run Code Online (Sandbox Code Playgroud)

.responseText 包含以下内容：

<SCRIPT>
    var urlArray = window.location.hash.split('/');
    if (urlArray != null) {
      var var1 = urlArray[1];
      window.location = "http://www.asx.com.au/asx/research/companyInfo.do?by=asxCode&asxCode=" + var1;
    }
</SCRIPT>

Run Code Online (Sandbox Code Playgroud)

如何像在浏览器中查看网页一样检索网页？我唯一没有尝试过的是创建一个浏览器对象可以从中获取 HTML。

Answer 1

ome*_*pes 5

网站http://www.asx.com.au有一个可用的 API。我通过链接http://www.asx.com.au/asx/share-price-research/company/AMC在 Chrome 中为其中一家公司 - AMC 打开了一个页面，然后打开了“开发人员工具”窗口 ( F12)、“网络”选项卡，并在单击每个部分后加载页面后检查列表中的 XHR。我发现了几个以 JSON 格式返回数据的 URL：

要查看所呈现数据的结构，可以将响应内容复制并粘贴到任何 JSON 查看器（例如，此在线工具http://jsonviewer.stack.hu）。

您可以使用下面的VBA代码来解析来自URL https://www.asx.com.au/asx/1/share/AMC/prices的响应并输出结果。将JSON.bas模块导入到 VBA 项目中以进行 JSON 处理。

Option Explicit

Sub Test_query_ASX()

    Const Transposed = False ' Output option

    Dim sCode As String
    Dim sInterval As String
    Dim sCount As String
    Dim sJSONString As String
    Dim vJSON As Variant
    Dim sState As String
    Dim aRows()
    Dim aHeader()

    sCode = "AMC"
    sInterval = "daily"
    sCount = "10"

    ' Get JSON via API
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.asx.com.au/asx/1/share/" & sCode & "/prices?interval=" & sInterval & "&count=" & sCount, False
        .Send
        sJSONString = .ResponseText
    End With
    ' Parse JSON response
    JSON.Parse sJSONString, vJSON, sState
    If sState = "Error" Then
        MsgBox "Invalid JSON"
        Exit Sub
    End If
    ' Pick core data
    vJSON = vJSON("data")
    ' Convert each data set to array
    JSON.ToArray vJSON, aRows, aHeader
    ' Output array to worksheet
    With ThisWorkbook.Sheets(1)
        .Cells.Delete
        If Transposed Then
            Output2DArray .Cells(1, 1), WorksheetFunction.Transpose(aHeader)
            Output2DArray .Cells(1, 2), WorksheetFunction.Transpose(aRows)
        Else
            OutputArray .Cells(1, 1), aHeader
            Output2DArray .Cells(2, 1), aRows
        End If
        .Columns.AutoFit
    End With
    MsgBox "Completed"

End Sub

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Run Code Online (Sandbox Code Playgroud)

运行Sub Test_query_ASX()以处理数据。Sheet1 上的输出对我来说如下：

通过该示例，您可以通过列出的 URL 从 JSON 响应中提取所需的数据。顺便说一句，其他答案中也应用了类似的方法。

更新

在网站上进行一些更改后，需要使用https://www.asx.com.au/asx/...而不是http://www.asx.com.au/b2c-api/...，因此我修复了上述所有 URL。

归档时间：	8 年，4 月前
查看次数：	3278 次
最近记录：	5 年，8 月前