Importing JSON Data into Excel

The below sample code is something I wrote for someone on another forum, the problem is that the Excel Web Data import doesn't work in dynamically built tables - built with JavaScript rather than being in the source of the document (as far as I can tell anyway).

The OP was trying to capture the leader board info from the PGA Tour website http://www.pga.com/openchampionship/scoring/leaderboard and the data import he had previously used had stopped working as the website design had changed. The leader board is created in the browser from javascript which periodically updates, the actual source of the data for the leaderboard is here:

http://data.pga.com/jsonp/event/open...aderboard.json

As you can see the data is in the form of a JSON object in a Javascript call back wrapper - JSON is extremely widely used on the web and allows storing complex data structures in a string, a single row of the above with some formatting applied, looks like this: http://pastebin.com/raw.php?i=khp1Ag3k

To extract this data and build a table that can be used in Excel, the JSON needs to be parsed - there is no built in library for reading JSON in Excel. The most simple way I have ever found of doing this is here: http://stackoverflow.com/questions/6...n-in-excel-vba

The above uses the Microsoft Script Control which can run JScript and return the values/objects of Jscript functions to VBA.

The below is the code that builds a table from the PGA JSON object and puts it into a sheet in Excel. The code is based on the code on SO, but adapted to work for this scenario. For the below to run you need to add a reference to Microsoft Script Control 1.0

Option Explicit
 
Private ScriptEngine As ScriptControl
 
Public Sub InitScriptEngine()
    Set ScriptEngine = New ScriptControl
    With ScriptEngine
        .Language = "JScript"
        .AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
        .AddCode "function getSubProperty(jsonObj, pKey, propertyName) { return jsonObj['lb']['p'][pKey][propertyName]; } "
        .AddCode "function getRoundinfo(jsonObj, pKey, rnd) { return jsonObj['lb']['p'][pKey]['rnd'][rnd]['str']; } "
        .AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj['lb']['p']) { keys.push(i); } return keys; } "
    End With
End Sub
 
Public Function DecodeJsonString(ByVal JsonString As String)
    Set DecodeJsonString = ScriptEngine.Eval("(" + JsonString + ")")
End Function
 
Public Function GetProperty(ByVal JsonObject As Object, ByVal PropertyName As String) As Variant
    GetProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName)
End Function
 
Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal PropertyName As String) As Object
    Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName)
End Function
 
Public Function GetKeys(ByVal JsonObject As Object) As String()
    Dim Length As Integer
    Dim KeysArray() As String
    Dim KeysObject As Object
    Dim Index As Integer
    Dim Key As Variant
 
    Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
    Length = GetProperty(KeysObject, "length")
    ReDim KeysArray(Length - 1)
    Index = 0
    For Each Key In KeysObject
        KeysArray(Index) = Key
        Index = Index + 1
    Next
    GetKeys = KeysArray
End Function
 
 
Public Sub RefreshScores()
    Dim JsonString As String
    Dim JsonObject As Object
    Dim Keys() As String
    Dim Output() As Variant
    Dim lRow As Long
    Dim lCol As Long
 
    InitScriptEngine
   
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://data.pga.com/jsonp/event/openchampionship/2012/leaderboard/json/leaderboard.json"
        .send
        Do: DoEvents: Loop Until .readystate = 4
        JsonString = Split(.responsetext, "callbackWrapper(")(1)
        .abort
    End With
 
    JsonString = Left(JsonString, Len(JsonString) - 2)
 
    Set JsonObject = DecodeJsonString(CStr(JsonString))
    Keys = GetKeys(JsonObject)
   
    ReDim Output(1 To UBound(Keys) + 1, 1 To 12)
    For lRow = 0 To UBound(Keys)
            Output(lRow + 1, 1) = ScriptEngine.Run("getSubProperty", JsonObject, Keys(lRow), "cp")
            Output(lRow + 1, 2) = ScriptEngine.Run("getSubProperty", JsonObject, Keys(lRow), "mv")
            Output(lRow + 1, 3) = ScriptEngine.Run("getSubProperty", JsonObject, Keys(lRow), "country")
            Output(lRow + 1, 4) = ScriptEngine.Run("getSubProperty", JsonObject, Keys(lRow), "fn")
            Output(lRow + 1, 4) = Output(lRow + 1, 4) & " " & ScriptEngine.Run("getSubProperty", JsonObject, Keys(lRow), "ln")
            Output(lRow + 1, 5) = ScriptEngine.Run("getSubProperty", JsonObject, Keys(lRow), "tpr")
            Output(lRow + 1, 6) = ScriptEngine.Run("getSubProperty", JsonObject, Keys(lRow), "th")
            Output(lRow + 1, 7) = ScriptEngine.Run("getSubProperty", JsonObject, Keys(lRow), "cpr")
            Output(lRow + 1, 8) = ScriptEngine.Run("getRoundinfo", JsonObject, Keys(lRow), "0")
            Output(lRow + 1, 9) = ScriptEngine.Run("getRoundinfo", JsonObject, Keys(lRow), "1")
            Output(lRow + 1, 10) = ScriptEngine.Run("getRoundinfo", JsonObject, Keys(lRow), "2")
            Output(lRow + 1, 11) = ScriptEngine.Run("getRoundinfo", JsonObject, Keys(lRow), "3")
            Output(lRow + 1, 12) = ScriptEngine.Run("getSubProperty", JsonObject, Keys(lRow), "ts")
    Next lRow
 
Sheet2.Cells(1, 1).Resize(UBound(Output), UBound(Output, 2)).Value = Output
 
End Sub

I'm pretty sure that there must be other useful applications of this library - but I can't think of any off the top of my head

Hope this helps someone

Cheers

Kyle