Разбор длинных json vba - PullRequest
Новая
       14

Разбор длинных json vba

0 голосов
/ 05 июня 2018

Не удается разобрать длинный JSON.Раньше я работал с «Jsonconverter» из Github, но никогда не работал с таким длинным JSON.Как и в ответе ниже, мне нужно получить 'odometerInMeters': 'Value', а затем и остальные значения, чтобы мне нужно было найти значение и объявить его в строковом поле.

код: 

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

Пример 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"
}
}

Ответы [ 2 ]

0 голосов
/ 06 июня 2018

Ладно, ребята, большое спасибо за весь вклад, не уверен, что это «лучшее» решение, но именно оно избавило меня от моих страданий:) 

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
0 голосов
/ 05 июня 2018

Если я запускаю его через свою функцию 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

найдено здесь VBA.CVRAPI

Я получаю этот вывод: 

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

Итак, проверьте это.

Чтобы получить одно значение, получите DataCollection и затем: 

Dim DataCollection      As Collection
Set DataCollection = CollectJson(ResponseText)    

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

Это модули Jsonxxxx.Слишком много кода, чтобы перечислить здесь.

...