JSON API to excel

[djgenesis13]

Hello guys,

I have a json api which uses a token in the format of https://someapi.com/pubapi.php?token=XXXXXXXXXX&mode=list which returns a json result.

I get the token from https://someapi.com/pubapi.php?get_token=get_token in the form of {"token":"XXXXXXXXXX"}

Using this online tool https://json-csv.com/ I am able to translate the json results insto csv and then import the csv to an excel file but it takes a lot of time to do this repeatedly manually step by step as every 15 minutes I have to get a new token.

I want to create a vba which

1)Calls https://someapi.com/pubapi.php?get_token=get_token to get the token
2)Uses the token in the json request https://someapi.com/pubapi.php?token=XXXXXXXXXX&mode=list
3)Get the results and Insert them in a specific excel sheet of my workbook (ex. "jsonresults")

 

[John_w]

Try the XMLhttpRequest object to send a GET request for steps 1 and 2, with a bit of VBA string parsing of the response, and Parsing JSON in Excel VBA - Stack Overflow to parse the JSON results into the sheet.

 

[djgenesis13]

I managed 1 & 2. I have been trying for hours to parse the json results into the sheet but no luck. could you please guide me how to do it?
thanks

 

[Kyle123]

Can you post the sample json?

 

[John_w]

I can't give specific help without seeing the JSON, but generally it is a series of calls to GetObjectProperty and/or GetProperty to drill down to the required part of the JSON, then you might call GetKeys and loop through the keys and call GetProperty to get the value of a specific field; something like this:

    Dim JsonObject As Object
    Dim JsonRecords As Object, JsonRecord As Object
    Dim recordKeys As Variant, recordKey As Variant
    
    InitScriptEngine
    Set JsonObject = DecodeJsonString(THE_JSON_STRING)
            
    Set JsonObject = GetObjectProperty(JsonObject, "main")
    Set JsonRecords = GetObjectProperty(JsonObject, "records")
    recordKeys = GetKeys(JsonRecords)
    For Each recordKey In recordKeys
        Set JsonRecord = GetObjectProperty(JsonRecords, recordKey)
        Debug.Print GetProperty(JsonRecord, "title")
        Debug.Print GetProperty(JsonRecord, "name")
        Debug.Print GetProperty(JsonRecord, "age")
    Next

The following code parses and dumps the JSON string to worksheet cells and will be helpful to understand the JSON structure. Add it to the module containing the StackOverflow code

'Parse/read JSON object recursively and output it to a worksheet starting at the specified cell

Public Function JSON_To_Cells(JsonObject As Variant, destCell As Range) As Long

    Dim Key As Variant
    Dim keyVal As Variant
    Dim n As Long
    
    n = 0
    For Each Key In GetKeys(JsonObject)
        keyVal = GetProperty(JsonObject, Key)
        If InStr(keyVal, "[object Object]") > 0 Then
            destCell.Offset(n, 0).Value = Key
            n = n + 1
            n = n + JSON_To_Cells(GetObjectProperty(JsonObject, Key), destCell.Offset(n, 1))
        Else
            destCell.Offset(n, 0).Value = Key
            destCell.Offset(n, 1).Value = keyVal
            n = n + 1
        End If
    Next
    JSON_To_Cells = n
    
End Function

and call it like this:

    Dim JsonString As String
    Dim JsonObject As Object

    JsonString = THE_XML_RESPONSE_TEXT
     
    InitScriptEngine
    Set JsonObject = DecodeJsonString(JsonString)
    Sheets("Sheet2").Cells.Clear
    JSON_To_Cells JsonObject, Sheets("Sheet2").Range("A1")

 

[djgenesis13]

take this as an example

http://www.omdbapi.com/?t=frozen&y=&plot=short&r=json

which returns this

{"Title":"Frozen","Year":"2013","Rated":"PG","Released":"27 Nov 2013","Runtime":"102 min","Genre":"Animation, Adventure, Comedy","Director":"Chris Buck, Jennifer Lee","Writer":"Jennifer Lee (screenplay), Hans Christian Andersen (inspired by the story \"The Snow Queen\" by), Chris Buck (story), Jennifer Lee (story), Shane Morris (story), Dean Wellins (additional story)","Actors":"Kristen Bell, Idina Menzel, Jonathan Groff, Josh Gad","Plot":"When the newly crowned Queen Elsa accidentally uses her power to turn things into ice to curse her home in infinite winter, her sister, Anna, teams up with a mountain man, his playful reindeer, and a snowman to change the weather condition.","Language":"English, Icelandic","Country":"USA","Awards":"Won 2 Oscars. Another 69 wins & 55 nominations.","Poster":"http://ia.media-imdb.com/images/M/MV5BMTQ1MjQwMTE5OF5BMl5BanBnXkFtZTgwNjk3MTcyMDE@._V1_SX300.jpg","Metascore":"74","imdbRating":"7.6","imdbVotes":"372,962","imdbID":"tt2294629","Type":"movie","Response":"True"}
So I need to end up with a sheet in excel with title, year etc in A1, B1 etc. and their respective values in A2, B2 etc

What would be a syntax for the module in vba?

Thanks

 

[Kyle123]

Like this:

Public Sub getData()

    Dim Movie As Object
    Dim scriptControl As Object

    Set scriptControl = CreateObject("MSScriptControl.ScriptControl")
    scriptControl.Language = "JScript"
    
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://www.omdbapi.com/?t=frozen&y=&plot=short&r=json", False
        .send
        Set Movie = scriptControl.Eval("(" + .responsetext + ")")
        .abort
        With Sheets(2)
            .Cells(1, 1).Value = Movie.Title
            .Cells(1, 2).Value = Movie.Year
            .Cells(1, 3).Value = Movie.Rated
            .Cells(1, 4).Value = Movie.Released
            .Cells(1, 5).Value = Movie.Runtime
            .Cells(1, 6).Value = Movie.Director
            .Cells(1, 7).Value = Movie.Writer
            .Cells(1, 8).Value = Movie.Actors
            .Cells(1, 9).Value = Movie.Plot
            .Cells(1, 10).Value = Movie.Language
            .Cells(1, 11).Value = Movie.Country
            .Cells(1, 12).Value = Movie.imdbRating
        End With
    End With
    
End Sub

Which I quite like the syntax of, but if you want a better supported (and probably faster method), consider returning the results in xml and parsing that:
http://www.omdbapi.com/?t=frozen&y=&plot=short&r=xml

 

[John_w]

Another way, getting all fields regardless of name:

Public Sub Get_JSON_Data()

    Dim JsonObject As Object
    Dim fields As Variant, field As Variant, c As Long
    
    InitScriptEngine
     
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://www.omdbapi.com/?t=frozen&y=&plot=short&r=json", False
        .send
        Set JsonObject = DecodeJsonString(.responseText)
    End With
     
    With Sheets(1)
        c = 1
        fields = GetKeys(JsonObject)
        For Each field In fields
            .Cells(1, c).Value = GetProperty(JsonObject, field)
            c = c + 1
        Next
    End With

End Sub

 

[djgenesis13]

Compile error: Sub or function not defined

 

[Kyle123]

If you're referring to John's code, then you will also need the code from stack overflow