json - Abrir página web, seleccionar todo, copiar en hoja

vba excel-vba

Question

He buscado por todas partes algo que me funcione en esto, ¡no tuve suerte! ¡Cualquier ayuda será muy apreciada! :) Buscando copiar datos de opciones de acciones de Barcharts.com y pegar en la hoja de Excel.

aquí es donde estoy:

Sub CopyTables()
Dim ie As Object
Dim I As Long
I = 0
Set ie = CreateObject("InternetExplorer.Application")
ie.navigate "https://www.barchart.com/stocks/quotes/GOOG/options?moneyness=allRows&view=sbs&expiration=2018-02-23"
ie.Visible = True
Do While ie.Busy And Not ie.readyState = 4
DoEvents
Loop
DoEvents
Set tables = ie.document.getElementsByTagName("table")
SetDataFromWebTable tables, Range("B5")
ie.Quit
End Sub

Si es posible, me encantaría también extraer las fechas del menú desplegable de la página web "Expiration" y pegarlas todas en Excel también. ¡Muchas gracias de antemano por cualquier ayuda en esto!

Answer 1

La fuente HTML de la página web mediante el enlace proporcionado

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

no contiene los datos necesarios, usa AJAX. El sitio web https://www.barchart.com tiene una API disponible. La respuesta se devuelve en formato JSON. Navegue por la página, por ejemplo, en Chrome, luego abra la ventana Herramientas para desarrolladores ( F12 ), pestaña Red , vuelva a cargar ( F5 ) la página y examine los XHR registrados. Los datos más relevantes son la cadena JSON devuelta por la 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

Puede usar el siguiente código de VBA para recuperar información como se describe anteriormente. Importe el módulo JSON.bas al proyecto VBA para el procesamiento JSON.

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

La salida para mí es la siguiente:

Para acercar la salida a la vista en paralelo en la página web, puede jugar un poco con los parámetros de consulta:

 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"), _
"&")

Y también cambia la línea

 Set vJSON = vJSON("data")

En ese caso, la salida es la siguiente:

Por cierto, el enfoque similar se aplica en las siguientes respuestas: 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 y 11 .