Object Required Error with JSON to VBA converting Process - json

Question

I got an error message
Run-Time '424' Object Required
when I click to debug it highlights this section to me For Each Value In Parsed("model")
Code is like below;
Sub Test1()
Dim FSO As New FileSystemObject
Dim JsonTS As TextStream
Dim JsonText As String
Dim Parsed As Scripting.Dictionary
' Read .json file
Set JsonTS = FSO.OpenTextFile("\exampleJSON.json", ForReading)
JsonText = JsonTS.ReadAll
JsonTS.Close
' Parse json to Dictionary
' "values" is parsed as Collection
' each item in "values" is parsed as Dictionary
Set Parsed = JsonConverter.ParseJson(JsonText)
' Prepare and write values to sheet
Dim Values As Variant
ReDim Values(Parsed("model").Count, 3)
Dim Value As Dictionary
Dim i As Long
i = 0
For Each Value In Parsed("model")
Values(i, 0) = Value("name")
Values(i, 1) = Value("type")
Values(i, 2) = Value("window")
i = i + 1
Next Value
Sheets("TEST_SHEET").Range(Cells(1, 1), Cells(Parsed("model").Count, 3)) = Values
End Sub
And the JSON file is like that:
{"model": {
"name": "Hakan",
"type": "on",
"window": {
"title": "Sample Konfabulator Widget",
"name": "main_window",
"width": 500,
"height": 500
},
"image": {
"src": "Images/Sun.png",
"name": "sun1",
"hOffset": 250,
"vOffset": 250,
"alignment": "center"
},
"text": {
"data": "Click Here",
"size": 36,
"style": "bold",
"name": "text1",
"hOffset": 250,
"vOffset": 100,
"alignment": "center",
"onMouseUp": "sun1.opacity = (sun1.opacity / 100) * 90;"
}
}}
What's the problem caused do you have any idea why there's not any object seen in VBA?

Answer 1

Try the below example to convert each model property into row of the table, and output the result to worksheet. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub Test()
Dim sJSONString As String
Dim vJSON As Variant
Dim sState As String
Dim aData()
Dim aHeader()
' Read JSON
sJSONString = ReadTextFile(ThisWorkbook.Path & "\source.json", -2)
' Parse JSON
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then MsgBox "Invalid JSON": Exit Sub
' Output "model" to the worksheet
JSON.ToArray vJSON("model"), aData, aHeader
With Sheets(1)
.Cells.Delete
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
.Rows.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, lFormat)
' 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
The output for the sample you provided is as follows:
BTW, the similar approach applied in other answers.