解析长json vba

时间:2018-06-05 14:24:11

标签: json vba access-vba

解析长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"
}
}

2 个答案:

答案 0 :(得分: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模块。列出的代码太多了。

答案 1 :(得分:0)

好的,非常感谢所有的投入,不确定这是否是最好的&#39;解决方案,但它是让我摆脱痛苦的那个:)

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