Harvesting few fields from json response

Question

I've written a script in vba to get some fields from a link which contains json data. As I've never worked with json in combination with vba, I don't have any idea which way I pursue. I heard that power query is an option but that would be difficult for me to cope up. Any alternative solution as to how I can get those fields depicted in the below image.

This is I've tried:

Sub CollectInformation()
    Dim ReqHttp As New XMLHTTP60, Ohtml As New HTMLDocument
    weblink = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"

    With ReqHttp
        .Open "GET", weblink, False
        .send
        Ohtml.body.innerHTML = .responseText
        MsgBox .responseText  ''I can see the valid response in the messagebox
   End With
End Sub

Fields I'm interested in:

A piece of scattered chunck:

"features":[{"type":"Feature","properties":{"HOOD":"Trinity-Bellwoods","center":"43.65241687364585 -79.41651445205076","streetview":{"lat":43.6452785,"lng":-79.4131849,"heading":-25.74,"pitch":"-1.34"},"rankings":{"Housing":19.7,"Crime":39.4,"Transit":73.9,"Shopping":88,"Health":33.1,"Entertainment":97.9,"Community":61.3,"Diversity":9.9,"Schools":64.8,"Employment":73.2},"irank":42,"urank":42},

To be clearer:

The keys are "HOOD","Housing","Crime","Shopping". I want to get their values.

So, there are a bunch of records, and you want to return the values for specific fields, from all records, is that correct? (As opposed to a few single-values?) — ashleedawg, Jun 16 '18 at 08:27

QHarr · Answer 1 · 2018-06-16T11:09:23.330

This will do it

Option Explicit

Sub GetInfo()
    '"HOOD","Housing","Crime","Shopping"
    Dim strURL As String, strJSON As String, http As Object, json As Object

    strURL = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"

    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", strURL, False
    http.send
    strJSON = http.responseText

    Set json = JsonConverter.ParseJson(strJSON)("features")

    Dim i As Long, key As Variant
    For i = 1 To json.count
        For Each key In json(i)
            Select Case True
            Case key = "properties"
                Dim a As Object, key2 As Variant
                Set a = json(i)(key)
                For Each key2 In a.Keys
                    Select Case key2
                    Case "HOOD"
                        Debug.Print "Hood" & " " & a(key2)
                    Case "rankings"
                        Dim b As Object
                        Set b = a(key2)
                        Debug.Print "Housing" & " :  " & b("Housing")
                        Debug.Print "Crime" & " :  " & b("Crime")
                        Debug.Print "Shopping" & " :  " & b("Shopping")
                    End Select
                Next key2
            End Select
        Next key
    Next i
End Sub

Example output:

Notes:

If you examine the JSON structure you can see it is as follows (sample)

The information we want in the dictionary returned is within "features" so we can extract that initially with:

Set json = JsonConverter.ParseJson(strJSON)("features")

This yields a collection (see the "[" at the start) of dictionaries. Within those dictionaries, we are interested in whenever the key "properties" appears, as those hold the items of interest. We can use a Select Case statement to filter for that key:

Select Case True
Case key = "properties"

We then set that to a variable, which is again a dictionary:

Set a = json(i)(key)

From the JSON image we can see again that we are interested in specific keys: HOOD and rankings; in order to get the items of interest ("HOOD","Housing","Crime","Shopping") .

HOOD and rankings return different datatypes.

HOOD returns a string:

So we can directly access the required value with the associated key:

a(key2)

I have added Debug.Print "Hood" & " " & a(key2) into the code to make it clear for you but have dropped the "Hood" prefix for my run as looks cleaner, in my opinion, in output.

rankings returns a dictionary, see the "{":

So, if we initially set that to a variable:

Set b = a(key2)

We can avoid looping the keys and directly access via the keys of interest i.e.:

Debug.Print "Housing" & " :  " & b("Housing")
Debug.Print "Crime" & " :  " & b("Crime")
Debug.Print "Shopping" & " :  " & b("Shopping")

I have added some descriptor text so make the output clearer.

score 1 · Answer 2 · answered Jun 16 '18 at 11:16

You don't need any external converter to play around with json data. There is already a robust method out there. To run the script you don't even add anything to the reference library other than what you did for xmlhttp requests. To get the corresponding values you need to use . dot operator to call it's keys. However, in some cases you might find some contradictory names like Status,Ranking,Properties which are already available in vba built-in items so you have to handle them using CallByName function like I've done below. It's even easier (the usage of it) than pulling any item from html elements out of a regular webpage.

This is how you can get your required items:

Sub FetchJsonInfo()
    Const URL As String = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"
    Dim Http As New XMLHTTP60, SC As Object, elem As Object
    Dim resobject As Object, post As Object, R&

    Set SC = CreateObject("ScriptControl")
    SC.Language = "JScript"

    With Http
        .Open "GET", URL, False
        .send
        Set resobject = SC.Eval("(" + .responseText + ")")
        .abort

        For Each post In resobject.features
            Set elem = CallByName(post, "properties", VbGet)
            R = R + 1: Cells(R, 1) = elem.HOOD
            Cells(R, 2) = elem.rankings.Housing
            Cells(R, 3) = elem.rankings.Crime
            Cells(R, 4) = elem.rankings.Shopping
        Next post
   End With
End Sub

Reference to add to the library:

Microsoft XML, v6.0

You should add that `scriptcontrol` is a 32bit component only and will not run inside a 64bit process. — drec4s, Jun 16 '18 at 11:24
Also worth noting that evaluating random js outside of a browser script engine sandbox leaves you open to malicious scripting attacks... https://stackoverflow.com/questions/6627652/parsing-json-in-excel-vba/30494373#30494373 — Tim Williams, Jun 16 '18 at 22:59
Yes, I noticed it and used the same approach around years but never came accross any such issues. However, If anyone thinks crossing a road might endanger his life doesn't mean he is not gonna cross the road. Thanks for the link, by the way. — SIM, Jun 16 '18 at 23:07

Harvesting few fields from json response

2 Answers2