JSON到VBA转换过程的对象必需错误

Question

我收到了一条错误消息

运行时'424'对象必需

当我点击调试它突出显示此部分给我For Each Value In Parsed("model")

代码如下;

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

而JSON文件是这样的：

{"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;"
    }
}}   

问题是什么？你知道为什么在VBA中没有看到任何对象吗？

Answer 1

尝试下面的示例将每个model属性转换为表的行，并将结果输出到工作表。将JSON.bas模块导入VBA项目以进行JSON处理。

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

您提供的示例的输出如下：