VBA JsonConverter.ParseJson Parse Jason 给我错误类型不匹配

使用 JSonParser，可以从示例 JSON 字符串中提取所需的值，如下所示；

Sub Test()
    Dim strJSON As String, JSon As Object, id As String, membersValue As String, rolesValue As String
    
    strJSON = "{""schemas"":[""urn:ietf:params:scim:schemas:core:2.0:Group"",""urn:sap:params:scim:schemas:extension:sac:2.0:group-roles"",""urn:sap:params:scim:schemas:extension:sac:2.0:group-custom-parameters""],""id"":""bef561ee-5a1e-420e-a1e\n4-4f624c96af6e"",""meta"":{""resourceType"":""Group"",""created"":""2024-07-25T14:17:53.215Z"",""lastModified"":""2024-08-01T14:31:29.632Z"",""location"":""/api/v1/scim2/Groups/bef561ee-5a1e-420e-a1e4-4f624c96af6e""},""displayName"":""TEAM_TEST"",""members"":[{""value"":""f27dcbb9-df9a-46b2-b23a-3b35d5a8bdff"",""type"":""User"",""display"":""Test_FirstName1 TEST_Familyname1"",""$ref"":""/api/v1/scim2/Users/f27dcbb9-df9a-46b2-b23a-3b35d5a8bdff""}],""urn:sap:params:scim:schemas:extension:sac:2.0:group-roles"":{""roles"":[{""value"":""PROFILE:t.4:VIEW_USER"",""display"":""VIEW_USER""}]},""urn:sap:params:scim:schemas:extension:sac:2.0:group-custom-parameters"":{""description"":""Team Test""}}"
      
    Set JSon = ParseJson(strJSON)

    id = JSon("id")
    
    membersValue = JSon("members")(1)("value")
    
    rolesValue = JSon("urn:sap:params:scim:schemas:extension:sac:2.0:group-roles")("roles")(1)("value")

    
    MsgBox "id = " & id & vbCrLf & "members.value = " & membersValue & vbCrLf & "roles.value = " & rolesValue
End Sub

键id与单个值相关联，而不是对象或数组，因此

tempName = JsonData("id")(0)
MsgBox (tempName)   'no parens as noted in BigBen's comment

应该

tempName = JsonData("id")
MsgBox tempName

我发现在每个步骤中单独访问 JSON 对象的不同部分要容易得多。这有助于避免大多数问题以及不同对象（字典和集合）之间的混淆。我一直使用这个参考资料，事实证明它有很大帮助。

因此，根据该建议并使用链接参考，我提出了下面的测试代码来展示如何访问 JSON 结构的不同部分并在适当的时候执行循环。

Option Explicit

Sub test()
    Dim strJSON As String
    strJSON = GetJSONString
    
    Dim json As Object
    Set json = ParseJson(strJSON)
    
    Dim resources As Collection
    Set resources = GetCollection(json, "Resources")
    
    Dim junk As Collection
    Set junk = GetCollection(json, "junk")
    
    Dim resource As Dictionary
    For Each resource In resources
        Debug.Print "----- Resource:"
        Dim schemas As Collection
        Set schemas = GetCollection(resource, "schemas")
        
        Dim i As Long
        For i = 1 To schemas.Count
            Debug.Print "   Schema(" & i & ") = " & schemas(i)
        Next i
        
        Dim id As String
        id = resource("id")
        
        Dim meta As Dictionary
        Set meta = GetDictionary(resource, "meta")
        If Not meta Is Nothing Then
            Dim metaEntry As Variant
            For Each metaEntry In meta
                Debug.Print "   Meta Entry: " & metaEntry & " = " & meta(metaEntry)
            Next metaEntry
        End If
        
        Dim displayName As String
        displayName = resource("displayName")
        
        Dim members As Collection
        Set members = GetCollection(resource, "members")
        If Not members Is Nothing Then
            Dim member As Variant
            Debug.Print "   member count = " & members.Count
            For i = 1 To members.Count
                Dim memberEntry As Dictionary
                Set memberEntry = members(i)
                Dim entryKey As Variant
                For Each entryKey In memberEntry
                    Debug.Print "   For member(" & i & "): " & entryKey & " = " & memberEntry(entryKey)
                Next entryKey
            Next i
        End If
    Next resource
End Sub

Function GetCollection(ByRef jsonObj As Object, ByVal entryName As String) As Collection
    On Error Resume Next
    Set GetCollection = jsonObj(entryName)
    If GetCollection Is Nothing Then
        Debug.Print "The requested object " & entryName & " does not exist in the referenced Collection"
    End If
End Function

Function GetDictionary(ByRef jsonObj As Object, ByVal entryName As String) As Dictionary
    On Error Resume Next
    Set GetDictionary = jsonObj(entryName)
    If GetDictionary Is Nothing Then
        Debug.Print "The requested object " & entryName & " does not exist in the referenced Dictionary"
    End If
End Function

Function GetJSONString() As String
    Dim fileHandle As Integer
    Dim filename As String
    filename = "C:\temp\test.json"
    fileHandle = FreeFile
    Open filename For Input As FreeFile
    GetJSONString = Input(LOF(fileHandle), fileHandle)
    Close fileHandle
End Function