Using VBA and VBA-JSON to access JSON data from Wordpress API

Question

I\'m building a VBA app that creates and modifies Wordpress website pages using resources scraped from the web. The Wordpress API returns a JSON file but there is no native

Answer 1

The JsonConverter is returning a collection of VBA.Collections Scripting.Dictionaries, and Values. In order to understand the output you will have to test the TypeName of all the returned values.

The real question is "How to navigate through a json object (or any unknown object for that matter) and access the values within.

Immediate Window

Using the Immediate Window and the json object from the OP's post I will try to describe the thought process (in the style of the must read book: The Little Schemer)

' What is json?
?TypeName(JSON)
Collection

'json is a collection
'How big is JSON
?JSON.Count
 1 

'JSON is a collection of 1 Item
'What is Type that Item?
?TypeName(JSON(1))
Dictionary

'JSON(1) is a Dictionary
'What is the first key in the JSON(1) Dictionary?
?JSON(1).Keys()(0)
id

'The first key in the JSON(1) Dictionary is "id"
'What is the Type of the value of "id"?
?TypeName(JSON(1)("id"))
Double

'JSON(1)("id") is a number
'What is its value
?JSON(1)("id")
 1 

Of course this process can get tedious consider the amount of nesting in this JSON Object.

JSON(1)("_links")("curies")(1)("templated")

Collection|Dictionary|Dictionary|Collection|Boolean Value

So I guess the best thing to do is write a function that will print all the accessor to the Immediate Window and go from there.

PrintJSONAccessors:Sub

Sub PrintJSONAccessors(JSON As Variant, Optional Prefix As String)
    Dim data As Variant, Key As Variant, Value As Variant
    Dim Accessor As String, ArrayAccessor As String
    Dim n As Long
    If TypeName(JSON) = "Collection" Then
        For n = 1 To JSON.Count
            Accessor = Prefix & "(" & n & ")"
            If TypeName(JSON(n)) = "Dictionary" Or TypeName(JSON(n)) = "Collection" Then
                PrintJSONAccessors JSON(n), Accessor
            Else
                Debug.Print Accessor
            End If
        Next
    Else
        For Each Key In JSON
            If TypeName(Key) = "Dictionary" Or TypeName(Key) = "Collection" Then
                PrintJSONAccessors Key, Prefix
            ElseIf TypeName(JSON(Key)) = "Dictionary" Or TypeName(JSON(Key)) = "Collection" Then
                Accessor = Prefix & "(" & Chr(34) & Key & Chr(34) & ")"
                PrintJSONAccessors JSON(Key), Accessor
            ElseIf TypeName(JSON(Key)) = "Dictionary" Then
                Accessor = Prefix & "(" & Chr(34) & Key & Chr(34) & ")"
                PrintJSONAccessors JSON(Key), Accessor
            ElseIf TypeName(JSON(Key)) = "Variant()" Then
                data = JSON(Key)
                For n = LBound(data) To UBound(data)
                    Accessor = Prefix & "(" & Chr(34) & Key & Chr(34) & ")"
                    ArrayAccessor = Prefix & "(" & Chr(34) & Key & Chr(34) & ")" & "(" & n & ")"
                    If TypeName(data(n)) = "Dictionary" Then
                        PrintJSONAccessors data(n), ArrayAccessor
                    Else
                        Debug.Print ArrayAccessor
                    End If
                Next
            Else
                Accessor = Prefix & "(" & Chr(34) & Key & Chr(34) & ")"
                Debug.Print Accessor
            End If
        Next
    End If
End Sub

Usage:

 PrintJSONAccessors JSON, "?JSON"

---

It appears that the MSScriptControl.ScriptControl only works on 32 bit systems. I guess that is what SIM was alluding to in his comments. Although, my answer is IMO correct, you should ignore the next section of comments.

FYI: I posted a function that parses the JSON into Arrays and Dictionaries Function to Return a JSON Like Objects Using VBA Collections and Arrays on Code Review. It is not a replacement for JsonConverter or omegastripes's JSON.Bas. It demonstrates that you can add JScript code to CreateObject("MSScriptControl.ScriptControl") and use it to process the JSON.

Answer 2

Try the code:

    Set json = JsonConverter.ParseJson(s)
    For Each k In json(1)
        Debug.Print k & vbTab & json(1)(k)
    Next

UPDATE

Take a look at the below example. Import JSON.bas module into the VBA project for JSON processing.

Option Explicit

Sub Test()

    Dim sJSONString As String
    Dim vJSON
    Dim sState As String
    Dim aData()
    Dim aHeader()
    Dim vResult

    ' Read JSON sample from file C:\Test\sample.json
    sJSONString = ReadTextFile("C:\Test\sample.json", 0)
    ' Parse JSON sample
    JSON.Parse sJSONString, vJSON, sState
    If sState = "Error" Then
        MsgBox "Invalid JSON"
        End
    End If
    ' Get the 1st element from root [] array
    Set vJSON = vJSON(0)
    ' Convert raw JSON to 2d array and output to worksheet #1
    JSON.ToArray vJSON, aData, aHeader
    With Sheets(1)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With
    ' Flatten JSON
    JSON.Flatten vJSON, vResult
    ' Convert flattened JSON to 2d array and output to worksheet #2
    JSON.ToArray vResult, aData, aHeader
    With Sheets(2)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With
    MsgBox "Completed"

End Sub

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Function ReadTextFile(sPath As String, lFormat As Long) As String

    ' lFormat -2 - System default, -1 - Unicode, 0 - ASCII
    With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 1, False, lFormat)
        ReadTextFile = ""
        If Not .AtEndOfStream Then ReadTextFile = .ReadAll
        .Close
    End With

End Function

BTW, the similar approach applied in other answers.