Quick program to download and parse UK Parliament Petition JSON data onto a worksheet

It's nice to pop onto my own blog and take some working code and re-apply it for a current problem. My JSON parsing posts are quite popular. In this instance I wanted to download and parse JSON data from the United Kingdom Parliamentary Petitions website.

The petition data gives two drill downs: (i) signature count by region and (ii) signature count by constituency.

The clever JSON parsing code is given to us by Douglas Crockford from his github site, you can see it being downloaded in the function SC (stands for Script Control).

Parsing returns a JSON object that is scriptable from VBA upon which we use VBA.CallByName(jsonObject, <property name>, VbGet) to drill down through the tree nodes.

If the scriptable JSON object is an array that it will support VBA's For Each .. Next syntax and so looping through is a breeze.

All the remaining code is simply plain vanilla that pastes the results on to the worksheet.

Don't forget to go to Tools->References and add the dependencies listed in the top comments or it will not compile. Also the code expects a worksheet with two sheets with codenames Sheet1 and Sheet2.

Enjoy!

Option Explicit

'* Tools->References
' MSScriptControl      Microsoft Script Control 1.0    C:\Windows\SysWOW64\msscript.ocx
' MSXML2               Microsoft XML, v6.0             C:\Windows\SysWOW64\msxml6.dll

Private Enum enuConstituencyColumns
    eCCMP = 0
    eCCName
    eCCONSCode
    eCCCountry
    eCCSigCount
    eCCFirst = eCCMP
    eCCLast = eCCSigCount
End Enum

Private Enum enuRegionColumns
    eRCName = 0
    eRCONSCode
    eRCSigCount
    eRCFirst = eRCName
    eRCLast = eRCSigCount
End Enum

Private Const clConsituencyCount As Long = 650
Private Const clRegionCount As Long = 12

Private Sub TestGetPetitionData()
    Const cl_petition_endchildfoodpoverty As Long = 554276 'no child should be going hungry  #endchildfoodpoverty
    GetPetitionData cl_petition_endchildfoodpoverty
End Sub

Private Sub GetPetitionData(ByVal lPetitionNumber As Long)
  
    Dim sPetitionJSON As String
    sPetitionJSON = RunHttpRequest("https://petition.parliament.uk/petitions/" & lPetitionNumber & ".json")
    
    Dim oSC As ScriptControl
    Set oSC = SC
    
    'Stop
    Dim objSafelyParsed As Object
    Set objSafelyParsed = SC.Run("JSON_parse", sPetitionJSON)
   
    Dim objDataAttributes As Object
    Set objDataAttributes = VBA.CallByName(VBA.CallByName(objSafelyParsed, "data", VbGet), "attributes", VbGet)
    

    
    '********** do the constituencies ***********
    Dim objConstituencySignatures As Object
    Set objConstituencySignatures = VBA.CallByName(objDataAttributes, "signatures_by_constituency", VbGet)
    
    
    Dim vConstituencies(0 To clConsituencyCount - 1, eCCFirst To eCCLast) As Variant
    
    Dim objConstituencyLoop As Object
    Dim idxConstituencyLoop As Long: idxConstituencyLoop = 0
    For Each objConstituencyLoop In objConstituencySignatures
    
        vConstituencies(idxConstituencyLoop, eCCMP) = CallByName(objConstituencyLoop, "mp", VbGet)
        vConstituencies(idxConstituencyLoop, eCCName) = CallByName(objConstituencyLoop, "name", VbGet)
        Dim sONSCode As String
        sONSCode = CallByName(objConstituencyLoop, "ons_code", VbGet)
        
        vConstituencies(idxConstituencyLoop, eCCONSCode) = sONSCode
        vConstituencies(idxConstituencyLoop, eCCCountry) = Left$(sONSCode, 1)
        
        vConstituencies(idxConstituencyLoop, eCCSigCount) = CallByName(objConstituencyLoop, "signature_count", VbGet)
        'Stop
        idxConstituencyLoop = idxConstituencyLoop + 1
    Next
    Sheet1.Cells.Clear
    WriteConstituencies Sheet1, vConstituencies
    
    
    '********** do the regions ***********
    Dim objRegionSignatures As Object
    Set objRegionSignatures = VBA.CallByName(objDataAttributes, "signatures_by_region", VbGet)
    
    Dim vRegions(0 To clRegionCount - 1, eRCFirst To eRCLast) As Variant
    Dim objRegionLoop As Object
    Dim idxRegionLoop As Long: idxRegionLoop = 0
    For Each objRegionLoop In objRegionSignatures
    
        vRegions(idxRegionLoop, eRCName) = CallByName(objRegionLoop, "name", VbGet)
        vRegions(idxRegionLoop, eRCONSCode) = CallByName(objRegionLoop, "ons_code", VbGet)
        
        vRegions(idxRegionLoop, eRCSigCount) = CallByName(objRegionLoop, "signature_count", VbGet)
    
        idxRegionLoop = idxRegionLoop + 1
    Next
    Sheet2.Cells.Clear
    WriteRegions Sheet2, vRegions
    
End Sub


Private Sub WriteConstituencies(ByVal ws As Excel.Worksheet, vConstituencies)
    Dim lVerticalCursor As Long
    lVerticalCursor = lVerticalCursor + 1
    
    ws.Cells(lVerticalCursor, eCCMP + 1) = "MP"
    ws.Cells(lVerticalCursor, eCCName + 1) = "Name"
    ws.Cells(lVerticalCursor, eCCONSCode + 1) = "ONS Code"
    ws.Cells(lVerticalCursor, eCCCountry + 1) = "Country"
    ws.Cells(lVerticalCursor, eCCSigCount + 1) = "Signature Count"
    lVerticalCursor = lVerticalCursor + 1
    
    Dim rngConstituencyPaste As Excel.Range
    Set rngConstituencyPaste = ws.Range(ws.Cells(lVerticalCursor, eCCFirst + 1), ws.Cells(lVerticalCursor + clConsituencyCount - 1, eCCLast + 1))
    
    'Debug.Assert rngConstituencyPaste.Columns.Count = 5
    'Debug.Assert rngConstituencyPaste.Rows.Count = 650
    
    rngConstituencyPaste.Value = vConstituencies
End Sub


Private Sub WriteRegions(ByVal ws As Excel.Worksheet, vRegions)
    Dim lVerticalCursor As Long
    lVerticalCursor = lVerticalCursor + 1
    
    ws.Cells(lVerticalCursor, eRCName + 1) = "Name"
    ws.Cells(lVerticalCursor, eRCONSCode + 1) = "ONS Code"
    ws.Cells(lVerticalCursor, eRCSigCount + 1) = "Signature Count"
    lVerticalCursor = lVerticalCursor + 1
    
    Dim rngRegionPaste As Excel.Range
    
    Set rngRegionPaste = ws.Range(ws.Cells(lVerticalCursor, eRCFirst + 1), ws.Cells(lVerticalCursor + clRegionCount - 1, eRCLast + 1))
    
    'Debug.Assert rngRegionPaste.Columns.Count = 3
    'Debug.Assert rngRegionPaste.Rows.Count = 12
    
    rngRegionPaste.Value = vRegions
End Sub


Private Function SC() As ScriptControl
    Static soSC As ScriptControl
    If soSC Is Nothing Then

        Set soSC = New ScriptControl
        soSC.Language = "JScript"
        
        '* https://stackoverflow.com/questions/45015/safely-turning-a-json-string-into-an-object
        soSC.AddCode RunHttpRequest("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
        soSC.AddCode "function JSON_parse(sJson) { return JSON.parse(sJson); } "
        

    End If
    Set SC = soSC
End Function

Private Function RunHttpRequest(ByVal sURL As String) As String

    Dim xHTTPRequest As MSXML2.XMLHTTP60
    Set xHTTPRequest = New MSXML2.XMLHTTP60
    xHTTPRequest.Open "GET", sURL, False
    xHTTPRequest.send
    RunHttpRequest = xHTTPRequest.responseText

End Function