解析长 json vba

Question

解析长 json 时遇到问题。 我以前使用过 Github 的“Jsonconverter”，但从来没有使用过这么长的 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"
}
}

Answer 1

如果我通过我的函数运行它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 模块。代码太多，这里就不一一列举了。

Answer 2

好的，伙计们，非常感谢所有的意见，不确定这是否是“最佳”解决方案，但它是让我摆脱痛苦的解决方案 :)

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