Open webpage, select all, copy into sheet

前端 未结 1 394
感动是毒
感动是毒 2021-01-22 12:19

Looking to copy Stock options data from Barcharts.com and paste into Excel sheet.

Sub CopyTables()

    Dim ie As Object
    Dim I As Long
    I = 0
    Set ie =         


        
相关标签:
1条回答
  • 2021-01-22 12:44

    The webpage source HTML by the link provided

    https://www.barchart.com/stocks/quotes/GOOG/options?moneyness=allRows&view=sbs&expiration=2018-02-23

    doesn't contain the necessary data, it uses AJAX. The website https://www.barchart.com has an API available. Response is returned in JSON format. Navigate the page e. g. in Chrome, then open Developer Tools window (F12), Network tab, reload (F5) the page and examine logged XHRs. Most relevant data is JSON string returned by the URL:

    https://core-api.barchart.com/v1/options/chain?symbol=GOOG&fields=optionType%2CstrikePrice%2ClastPrice%2CpercentChange%2CbidPrice%2CaskPrice%2Cvolume%2CopenInterest&groupBy=strikePrice&meta=field.shortName%2Cfield.description%2Cfield.type&raw=1&expirationDate=2018-02-23

    You may use the below VBA code to retrieve info as described above. Import JSON.bas module into the VBA project for JSON processing.

    Option Explicit
    
    Sub Test48759011()
    
        Dim sUrl As String
        Dim sJSONString As String
        Dim vJSON As Variant
        Dim sState As String
        Dim aData()
        Dim aHeader()
    
        sUrl = "https://core-api.barchart.com/v1/options/chain?" & _
            Join(Array( _
                "symbol=GOOG", _
                "fields=" & _
                Join(Array( _
                    "optionType", _
                    "strikePrice", _
                    "lastPrice", _
                    "percentChange", _
                    "bidPrice", _
                    "askPrice", _
                    "volume", _
                    "openInterest"), _
                "%2C"), _
                "groupBy=", _
                "meta=" & _
                Join(Array( _
                    "field.shortName", _
                    "field.description", _
                    "field.type"), _
                "%2C"), _
                "raw=1", _
                "expirationDate=2018-02-23"), _
            "&")
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", sUrl, False
            .send
            sJSONString = .responseText
        End With
        JSON.Parse sJSONString, vJSON, sState
        vJSON = vJSON("data")
        JSON.ToArray vJSON, aData, aHeader
        With Sheets(1)
            .Cells.Delete
            .Cells.WrapText = False
            OutputArray .Cells(1, 1), aHeader
            Output2DArray .Cells(2, 1), aData
            .Columns.AutoFit
        End With
    
    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
    

    The output for me is as follows:

    To make output closer to Side-by-Side view on the webpage, you may slightly play with query parameters:

        sUrl = "https://core-api.barchart.com/v1/options/chain?" & _
            Join(Array( _
                "symbol=GOOG", _
                "fields=" & _
                Join(Array( _
                    "optionType", _
                    "strikePrice", _
                    "lastPrice", _
                    "percentChange", _
                    "bidPrice", _
                    "askPrice", _
                    "volume", _
                    "openInterest"), _
                "%2C"), _
                "groupBy=strikePrice", _
                "meta=", _
                "raw=0", _
                "expirationDate=2018-02-23"), _
            "&")
    

    And also change the line

        Set vJSON = vJSON("data")
    

    In that case the output is as follows:

    BTW, the similar approach applied in other answers.

    0 讨论(0)
提交回复
热议问题