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

Sounds good! ...what's the question? Are you getting any errors? Where? — Mathieu Guindon
– Mathieu Guindon, Commented Jun 5, 2018 at 14:42
^^ and "I need to get 'odometerInMeters':'Value' And later on the rest of the values" - how much later on? — QHarr
– QHarr, Commented Jun 5, 2018 at 14:50
How long is the "such a long json"? How many times the above example should be repeated to show the actual size? — omegastripes
– omegastripes, Commented Jun 5, 2018 at 22:24

Gustav · Accepted Answer · 2018-06-06 12:40:52Z

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.

edited Jun 6, 2018 at 12:40

answered Jun 5, 2018 at 14:51

Gustav

56.4k7 gold badges33 silver badges65 bronze badges

Sign up to request clarification or add additional context in comments.

7 Comments

QHarr Over a year ago

Ok. That beat my typing out an answer

Gustav Over a year ago

@QHarr: Oh well. Many ways to do this, but I actually had the modules open for another project.

QHarr Over a year ago

Well you got my upvote and I will enjoy having a look at the code so thank you for sharing.

Gregory Over a year ago

@Gustav: Thanks! looks create, managed to achieve the same result, one more question, (never worked with 'Collections' before): How do I get the value from 'odometerInMeters' in this result?

Gustav Over a year ago

Can't tell. I used your Json data and the line of codes at the bottom of the edited answer.

|

Gregory · Accepted Answer · 2018-06-06 20:10:29Z

0

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

answered Jun 6, 2018 at 20:10

Gregory

1592 gold badges5 silver badges13 bronze badges

2 Comments

QHarr Over a year ago

Get rid of that on Error Resume Next and handle errors appropriately or close it with On Error GoTo 0 as soon as possible otherwise you are masking any errors for the rest of the proc.

QHarr Over a year ago

Also, look at using Select Case over repeated If statements.

Collectives™ on Stack Overflow

Parse long json vba

2 Answers 2

7 Comments

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

7 Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related