Parse long json vba

Question

Having trouble parsing a long json. I've worked before with 'Jsonconverter' from Github but never with such a long json. As from the response below I need to get 'odometerInMeters':'Value' And later on the rest of the values as well so I need to be able to search for a value and declare it into a string-field.

code:

xmlhttp.Open "GET", URL, False
xmlhttp.SetRequestHeader "Content-Type", "application/json"
xmlhttp.SetRequestHeader "x-api-key", xapikey
xmlhttp.SetRequestHeader "Authorization", Token
xmlhttp.Send


Dim Parsed As Dictionary
Set Parsed = mdl_JsonConverter.ParseJson(xmlhttp.ResponseText)
Dim Values As Variant
ReDim Values(Parsed("values").Count, 3)

Dim Value As Dictionary
Dim i As Long

i = 0
For Each Value In Parsed("values")
  Values(i, 0) = Value("odometerInMeters")("value")
  i = i + 1
Next Value

Example JSON:

{
"vehicle": {
    "vehicleId": "TESTID",
    "vin": "2651654156161651561"
},
"ignitionState": {
    "state": "IGNITION_OFF",
    "timestampObserved": "2018-04-30T23:17:05.000Z"
},
"warningBrakeLiningWear": null,
"warningBrakeFluid": {
    "value": false,
    "timestampObserved": "2018-04-28T08:32:43.000Z"
},
"tankLevelPercent": null,
"warningWashWater": {
    "value": false,
    "timestampObserved": "2018-04-28T08:32:43.000Z"
},
"warningLowBattery": {
    "value": false,
    "timestampObserved": "2018-04-28T08:32:43.000Z"
},
"warningCoolantLevelLow": {
    "value": false,
    "timestampObserved": "2018-04-28T08:32:43.000Z"
},
"engineCoolantTemperatureCelsius": null,
"engineOilTemperatureCelsius": null,
"parkBrakeStatus": null,
"roofTopStatus": null,
"sunroofStatus": null,
"sunroofEvent": null,
"liquidConsumptionStart": null,
"liquidConsumptionReset": null,
"rangeLiquidInMeters": null,
"liquidRangeSkipIndication": null,
"gasConsumptionStart": null,
"gasConsumptionReset": null,
"gasTankLevelInLitres": null,
"gasTankRangeInMeters": null,
"odometerInMeters": {
    "value": 97156000,
    "timestampObserved": "2018-04-30T23:17:05.000Z"
},
"position": {
    "latitude": 99.11466,
    "longitude": 99.54858,
    "altitude": null,
    "speed": 20,
    "heading": 0,
    "timestampObserved": "2018-04-30T23:17:05.000Z"
},
"tyreWarningLamp": null,
"tyreFrontLeft": {
    "status": "NONE",
    "pressureInPascal": 583200,
    "timestampObserved": "2018-04-28T08:32:43.000Z"
},
"tyreFrontRight": {
    "status": "NONE",
    "pressureInPascal": 344700,
    "timestampObserved": "2018-04-28T08:32:43.000Z"
},
"tyreRearLeft": {
    "status": "NONE",
    "pressureInPascal": 136600,
    "timestampObserved": "2018-04-28T08:32:43.000Z"
},
"tyreRearRight": {
    "status": "NONE",
    "pressureInPascal": 433800,
    "timestampObserved": "2018-04-28T08:32:43.000Z"
},
"tyreWarningPRW": null,
"serviceIntervalDays": null,
"serviceIntervalDistanceInMeters": null,
"maxRangeInMeters": null,
"drivenTimeInSecondsStart": null,
"drivenTimeInSecondsReset": null,
"averageSpeedInMetersPerSecondStart": null,
"averageSpeedInMetersPerSecondReset": null,
"distanceInMetersStart": null,
"distanceInMetersReset": null,
"immobilizerActive": null,
"centralLockOverallLockState": null,
"batteryVoltage": {
    "value": 12.3,
    "timestampObserved": "2018-04-28T08:32:43.000Z"
}
}

Answer 1

Ok guys, many thanks for all the input, not sure if this is the 'best' solution but it's the one that removed me from my suffering :)

Dim json As Dictionary
Dim item As Dictionary
Dim tempjson As Object, tempItem As Object
Set json = mdl_JsonConverter.ParseJson(XmlHttp.ResponseText) '


For Each json_Key In json.Keys

'some lines are <NULL> values
On Error Resume Next:

Set item = json(json_Key)

    Partialjson = (mdl_JsonConverter.ConvertToJson(item))
    Set tempjson = mdl_JsonConverter.ParseJson(Partialjson)

    If json_Key = "vehicle" Then
        vehicle = tempjson("vehicleId")
        vin = tempjson("vin")
    End If

    If json_Key = "odometerInMeters" Then
        Mileage = tempjson("value") / 1000

    Else
    End If
'....


Next

Answer 2

If I run it through my function TestJsonResponseText:

' Analyze a manually entered Json string.
'
Public Sub TestJsonResponseText( _
    ByVal ResponseText As String)

    Dim DataCollection      As Collection
'    ResponseText = InputBox("Json")
    If ResponseText <> "" Then
        Set DataCollection = CollectJson(ResponseText)
        MsgBox "Retrieved" & Str(DataCollection.Count) & " root member(s)", vbInformation + vbOKOnly, "Web Service Success"
    End If

    Call ListFieldNames(DataCollection)

    Set DataCollection = Nothing

End Sub

found here VBA.CVRAPI

I receive this output:

root                        
    vehicle                 
        vehicleId           TESTID
        vin                 2651654156161651561
    ignitionState           
        state               IGNITION_OFF
        timestampObserve    2018-04-30T23:17:05.000Z
    warningBrakeLini        Null
    warningBrakeFlui        
        value               False
        timestampObserve    2018-04-28T08:32:43.000Z
    tankLevelPercent        Null
    warningWashWater        
        value               False
        timestampObserve    2018-04-28T08:32:43.000Z
    warningLowBatter        
        value               False
        timestampObserve    2018-04-28T08:32:43.000Z
    warningCoolantLe        
        value               False
        timestampObserve    2018-04-28T08:32:43.000Z
    engineCoolantTem        Null
    engineOilTempera        Null
    parkBrakeStatus         Null
    roofTopStatus           Null
    sunroofStatus           Null
    sunroofEvent            Null
    liquidConsumptio        Null
    liquidConsumptio        Null
    rangeLiquidInMet        Null
    liquidRangeSkipI        Null
    gasConsumptionSt        Null
    gasConsumptionRe        Null
    gasTankLevelInLi        Null
    gasTankRangeInMe        Null
    odometerInMeters        
        value               97156000
        timestampObserve    2018-04-30T23:17:05.000Z
    position                
        latitude            99.11466
        longitude           99.54858
        altitude            Null
        speed               20
        heading             0
        timestampObserve    2018-04-30T23:17:05.000Z
    tyreWarningLamp         Null
    tyreFrontLeft           
        status              NONE
        pressureInPascal    583200
        timestampObserve    2018-04-28T08:32:43.000Z
    tyreFrontRight          
        status              NONE
        pressureInPascal    344700
        timestampObserve    2018-04-28T08:32:43.000Z
    tyreRearLeft            
        status              NONE
        pressureInPascal    136600
        timestampObserve    2018-04-28T08:32:43.000Z
    tyreRearRight           
        status              NONE
        pressureInPascal    433800
        timestampObserve    2018-04-28T08:32:43.000Z
    tyreWarningPRW          Null
    serviceIntervalD        Null
    serviceIntervalD        Null
    maxRangeInMeters        Null
    drivenTimeInSeco        Null
    drivenTimeInSeco        Null
    averageSpeedInMe        Null
    averageSpeedInMe        Null
    distanceInMeters        Null
    distanceInMeters        Null
    immobilizerActiv        Null
    centralLockOvera        Null
    batteryVoltage          
        value               12.3
        timestampObserve    2018-04-28T08:32:43.000Z

So, check that out.

To retrieve a single value, get the DataCollection and then:

Dim DataCollection      As Collection
Set DataCollection = CollectJson(ResponseText)    

ItemName = DataCollection("odometerInMeters")(CollectionItem.Data)("value")(CollectionItem.Name)    
ItemData = DataCollection("odometerInMeters")(CollectionItem.Data)("value")(CollectionItem.Data)

It's the Jsonxxxx modules. Too much code to list here.