VBA web scraping from CME group - html

Question

I am trying to import crude oil data from the API at this web site: Crude Oil 1 Options Quotes
I want to get Options data of All Strike Range.
When I tried to get it by clicking From Web in the Data tab in Excel, the web site only showed At the Money Strike Range.
I am trying to get: Type: American Options, Expiration: Jun 2016, Strike Range: All
How could I import the crude oil data to Excel spreadsheet using VBA?

Answer 1

Fiddler and web traffic:
I inspected the web traffic whilst on this page using fiddler. I saw that there was a GET request made for the data of interest. N.B. I went with the default info on the page. Making changes may result in a POST request which will follow broadly the same approach but would require a parameter based POST request with any required Header information and the like.
Fiddler output:
JSON response:
This GET request returned a JSON string containing all the CALLS/PUTS.
JSON sample:
JSON preview:
So I replicated this GET request using XMLHTTP request and then used JSONConverter to handle the JSON string returned*.
*Note: After downloading JSONConverter.bas and adding to project you must add a reference to Microsoft Scripting Runtime via VBE > Tools > References
The object generated by Set JSON = JsonConverter.ParseJson(sResponse) is a dictionary as denoted by the leading "{".
JSON object handling:
I used JSONConverter to handle accessing information from the JSON Object.
The initial dictionary has keys of "quoteDelayed","quoteDelay","tradeDate","optionContractQuotes","underlyingFutureContractQuotes","empty".
Reviewing the webpage:
The following shows the webpage headers and first data row.
I am looking in the JSON structure for information on Calls, Strike Price and Puts. This info appears to be under key "optionContractQuotes"
Required information:
So, we can re-assign JSON to this part of the original JSON (we could have jumped straight to this but I thought it might help to explain) with:
Set JSON = JSON("optionContractQuotes")
Collection of dictionaries:
A quick inspection of the new JSON structure tells me this will be a collection of dictionaries. The "[" tells me I have a collection and the following "{", as before, tells me I then have dictionaries, as "{" is repeated, inside.
A closer examination shows me that these dictionaries have keys of "strikePrice","strikeRank","put","call","underlyingFutureContract".
The info we really care about:
We care about keys "strikePrice", "put" and "call". "strikePrice" key has primitive string value e.g.
"strikePrice": "140.0",
"put" and "call" keys have associated dictionaries. Remember the "{"?
Example keys from call dictionary object:
What we can see from the above, is that the keys of the dictionaries "put" and "call" correspond to the original source headers, and the values correspond to the rows of information we saw originally in the webpage source table.
Caveat: There are slight differences between the webpage headers and the associated JSON headers (there is also more info in the JSON...), so mapped headers are used for accessing the JSON structure to then write out to the appropriate column in the sheet:
jsonHeaders = Array("updated", "highLowLimits", "volume", "high", "low", "priorSettle", "change", "last")
Why bother?
The above analysis of the JSON structure has led us to a point where we now know:
Where the items are located that we are interested in
How these items would map to our output table (remember the point raised about headers and row data?).
Writing to the sheet:
To make things easier I am going to actually hard code the headers for "calls" and "puts" in the sheet with:
headers = Array("Updated", "Hi / Low Limit", "Volume", "High", "Low", "Prior Settle", "Change", "Last", "Strike Price", "Last", "Change", "Prior Settle", "Low", "High", "Volume", "Hi / Low Limit", "Updated")
I can then write those out in one go as my table headers with:
.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
I know that my rows are "call", "Strike Price", "put". And that "put" headers are the same headers as "call" headers, but in reverse order:
This handy observation means, when I am looping each dictionary in the collection, which is effectively a row of information to population the table with; I can pass each dictionary to a helper sub, WriteToSheet. This helper sub uses the keys of interest to access the dictionary values and write them to the sheet. If "strikePrice" the associated value can be written direct to column 9, the middle of our table. Otherwise, if it is either "call" or "put", we can loop the jsonHeaders array to access the required inner dictionary information. Remember that "call" and "put" are dictionaries in their own right, whereas "strikePrice" was a primitive string.
To save looping the headers twice, once for "put" and once for "call", I shorthand the whole thing into a single loop:
For i = LBound(jsonHeaders) To UBound(jsonHeaders) '<==Dictionaries
.Cells(rowCounter, i + 1).Value = inputDict("call")(jsonHeaders(i))
.Cells(rowCounter, 17 - i).Value = inputDict("put")(jsonHeaders(i))
Next i
And bish, bash, bosh we have our table in the sheet.
Sample view of webpage:
View of code output:
VBA:
Option Explicit
Public Sub GetCrudeOilOptionQuotes()
Dim sResponse As String, JSON As Object, headers(), jsonHeaders(), ws As Worksheet
headers = Array("Updated", "Hi / Low Limit", "Volume", "High", "Low", "Prior Settle", "Change", "Last", "Strike Price", "Last", "Change", "Prior Settle", "Low", "High", "Volume", "Hi / Low Limit", "Updated")
jsonHeaders = Array("updated", "highLowLimits", "volume", "high", "low", "priorSettle", "change", "last") '<== JSON headers vary from visible headers on page slightly
'Ignored headers open,close,highLimit,lowLimit
Set ws = ActiveSheet
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.cmegroup.com/CmeWS/mvc/Quotes/Option/769/G/Q8/ATM?optionExpiration=190-M6&strikeRange=ATM&optionProductId=769&pageSize=500&_=1530436274974", False
.send
sResponse = StrConv(.responseBody, vbUnicode)
End With
Set JSON = JsonConverter.ParseJson(sResponse) 'Returns a dictionary
Dim i As Long, rowCounter As Long
Set JSON = JSON("optionContractQuotes") '<==Collection of dictionaries
rowCounter = 1
With ws
.UsedRange.ClearContents
.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
End With
For i = 1 To JSON.Count 'Loop all the dictionaries to empty info into rows and columns of sheet
rowCounter = rowCounter + 1
WriteToSheet JSON(i), jsonHeaders, rowCounter, ws
Next i
End Sub
Public Sub WriteToSheet(ByVal inputDict As Object, ByVal jsonHeaders As Variant, ByVal rowCounter As Long, ByVal ws As Worksheet)
Application.ScreenUpdating = False
Dim key As Variant, i As Long
With ws
.Cells(rowCounter, 9).Value = inputDict("strikePrice") '<==literal string
For i = LBound(jsonHeaders) To UBound(jsonHeaders) '<==Dictionaries
.Cells(rowCounter, i + 1).Value = inputDict("call")(jsonHeaders(i))
.Cells(rowCounter, 17 - i).Value = inputDict("put")(jsonHeaders(i))
Next i
End With
Application.ScreenUpdating = True
End Sub

Answer 2

For something like this, where the values change very frequently, I think you should use Power Query. The reason is, PQ will just be cleaner and more robust, and you don't have to rely on complex VBA code to grab your data, especially when VBA is somewhat unstable with these kinds of things, and I believe you are putting some real money behind this so you want to absolutely rely on the data you get.
Simply download and install PQ.
https://www.microsoft.com/en-us/download/confirmation.aspx?id=39379
Point it to your desired URL and run it. Then, put PQ on a timer, so it refreshes every 1 minute or so. Data > Connections > Properties.
I talk about this and a lot of other similar techniques in my book, which you can find here.
https://www.amazon.com/Automating-Business-Processes-Reducing-Increasing-ebook/dp/B01DJJKVZC?ie=UTF8&keywords=ryan%20shuell&qid=1464012902&ref_=sr_1_1&sr=8-1