Excel VBA - 检索包含JS内容的网页不是脚本 [英] Excel VBA - Retrieve webpage including JS content not script

问题描述

我一直在使用VBA从ASX网站（www.asx.com.au）中检索股票一段时间，但是我的脚本不再工作，因为网站已经更新，现在使用javascript来构建

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

VBA（漂亮的股票标准）：

 使用CreateObject（WINHTTP.WinHTTPRequest.5.1）
。 GET，strURL，False 
 .send 
 http.body.innerHTML = .responseText 
结束
  

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

解决方案

网站

有了这个例子，您可以通过列出的URL从JSON响应中提取所需的数据。 BTW，与此和这个答案。

I've been using VBA to retrieve stock prices from the ASX website (www.asx.com.au) for quite some time, however, my script no longer works as the website has been updated and now uses javascripts to build the content.

As a result, the script shown below now return the sections rather than the page content.

The VBA (pretty stock standard):

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

And the .responseText contains things like:

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

How can I retrieve the webpage as one would view it in the browser? The only thing I've not tried is creating a browser object can grabbing the HTML from that.

解决方案

The website http://www.asx.com.au has an API available. I opened a page in Chrome for one of the companies - AMC by the link http://www.asx.com.au/asx/share-price-research/company/AMC, then opened Developer Tools window (F12), Network tab, and examined XHRs in the list after the page was loaded after I clicked each section. I found several URLs which return data in JSON format:

• http://www.asx.com.au/b2c-api/1/company/AMC?fields=primary_share,latest_annual_reports,last_dividend,primary_share.indices
• http://www.asx.com.au/b2c-api/1/company/AMC/similar?compare=marketcap
• http://www.asx.com.au/b2c-api/1/company/AMC/announcements?count=10&market_sensitive=false
• http://www.asx.com.au/b2c-api/1/chart/highcharts?asx_code=AMC&years=10
• http://www.asx.com.au/b2c-api/1/share/AMC/prices?interval=daily&count=10
• http://www.asx.com.au/b2c-api/1/company/AMC/dividends/history?years=5
• http://www.asx.com.au/b2c-api/1/company/AMC/dividends
• http://www.asx.com.au/b2c-api/1/company/AMC/options?count=5000
• http://www.asx.com.au/b2c-api/1/company/AMC/warrants?count=5000
• http://www.asx.com.au/b2c-api/1/company/AMC/people

To see a structure of the presented data the response contents could be copied and pasted to any JSON viewer (e. g. this online tool http://jsonviewer.stack.hu).

You may use the below VBA code to parse response from the URL http://www.asx.com.au/b2c-api/1/share/AMC/prices and output result. Import JSON.bas module into the VBA project for JSON processing.

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", "http://www.asx.com.au/b2c-api/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 Sub Test_query_ASX() to process data. The output on the Sheet1 for me is as follows:

Having that example you can extract the data you need from the JSON responses by the listed URLs. BTW, the same approach used in this and this answers.

这篇关于Excel VBA - 检索包含JS内容的网页不是脚本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！