Question

我一直在使用VBA从ASX网站（www.asx.com.au）检索股票价格很长一段时间，然而，我的脚本不再有效，因为网站已经更新，现在使用javascripts来构建内容。

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

VBA（漂亮的股票标准）：

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

.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>

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

Answer 1

网站http://www.asx.com.au有一个API可用。我在其中一家公司的Chrome浏览器中打开了一个页面 - AMC链接http://www.asx.com.au/asx/share-price-research/company/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

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

通过该示例，您可以通过列出的URL从JSON响应中提取所需的数据。 BTW，与this和this答案中使用的方法相同。

<强>更新

在网站上进行一些更改后，有必要使用https://www.asx.com.au/asx/...代替http://www.asx.com.au/b2c-api/...，因此我修复了以上所有网址。

检索包含AJAX内容的网页

1 个答案: