Search code examples
jsonvbajsonconverter

VBA JsonConverter.ParseJson Parse Jason giving me error Type Mismatch


I have below Json value in string groupsjasontext and I like to parse id, members.value, roles.value using JsonConverter.ParseJson. How will I do it ? I tried to show via messagebox for id field and I am getting error Type Mismatch

    Set JsonData = JsonConverter.ParseJson(groupsjasontext)
    tempName = JsonData("id")(0)
    MsgBox (tempName)
    {
  "schemas": [
    "urn:ietf:params:scim:api:messages:2.0:ListResponse"
  ],
  "totalResults": 3,
  "startIndex": 1,
  "itemsPerPage": 3,
  "Resources": [
    {
      "schemas": [
        "urn:ietf:params:scim:schemas:core:2.0:Group",
        "urn:sap:params:scim:schemas:extension:sac:2.0:group-custom-parameters"
      ],
      "id": "d3094970-ce7e-4794-b9e2-f84817b7c820",
      "meta": {
        "resourceType": "Group",
        "created": "2024-05-21T17:53:06.808Z",
        "lastModified": "2024-05-21T17:53:06.808Z",
        "location": "/api/v1/scim2/Groups/d3094970-ce7e-4794-b9e2-f84817b7c820"
      },
      "displayName": "AHI_VW_ALL_REGION",
      "urn:sap:params:scim:schemas:extension:sac:2.0:group-custom-parameters": {
        "description": "View Mode ALL REGION"
      }
    },
    {
      "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"
      }
    },
    {
      "schemas": [
        "urn:ietf:params:scim:schemas:core:2.0:Group",
        "urn:sap:params:scim:schemas:extension:sac:2.0:group-custom-parameters"
      ],
      "id": "1edd9227-c8de-486e-93f6-69396524c792",
      "meta": {
        "resourceType": "Group",
        "created": "2024-05-21T17:51:49.808Z",
        "lastModified": "2024-05-21T17:53:06.121Z",
        "location": "/api/v1/scim2/Groups/1edd9227-c8de-486e-93f6-69396524c792"
      },
      "displayName": "AHI_VW_EURAM\n",
      "urn:sap:params:scim:schemas:extension:sac:2.0:group-custom-parameters": {
        "description": "View mode EURAM"
      }
    }
  ]
}

Solution

  • I have found it far easier to specifically access different parts of a JSON object individually at each step. This helped to avoid most of the issues and confusion between the different objects (Dictionaries and Collections). I use this reference all the time, it's proved to be a big help.

    So based on that advice, and using the linked reference, I came up with the test code below to show how to access different parts of your JSON structure and perform loops when it's appropriate.

    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