json - 使用 VBA 遍历嵌套 JSON
问题描述
我有一个我试图在 VBA 中解析的 JSON。JSON 类似于以下内容：
{
"participantEligibilityResults": [
{
"eligibilityResult": {
"participantId": "HSA92a",
"clientId": "NIRCCCONFIG",
"environment": "CONFIG",
"errorReason": null,
"previousEvent": {
"eventDate": "2019-01-01",
"eventReason": "7",
"eligibilityDetails": [
{
"standardBenefitAreaId": "SPLIFE",
"benefitOptionId": "1XPay",
"coverageLevelId": "PPSP",
"employeeMonthlyCost": 216.67,
"employerMonthlyCost": 0.0,
"benefitProgramId": "ProgH"
},
{
"standardBenefitAreaId": "SPLIFE",
"benefitOptionId": "NoCoveragePay",
"coverageLevelId": null,
"employeeMonthlyCost": 0.0,
"employerMonthlyCost": 0.0,
"benefitProgramId": "ProgH"
}
],
"dependents": []
},
"currentEvent": {
"eventDate": "2020-03-14",
"eventReason": "5",
"eligibilityDetails": [
{
"standardBenefitAreaId": "BASICCHLIFE",
"benefitOptionId": "BCHWaive",
"coverageLevelId": null,
"employeeMonthlyCost": 0.0,
"employerMonthlyCost": 0.0,
"benefitProgramId": "ProgH",
"beneficiaryCollection": "Not Applicable",
"maxCoverageAmount": 0.0,
"minCoverageAmount": 0.0,
"coverageAmount": 0.0,
"preTax": true,
"postTax": false,
"userDefinedTaxability": false,
"numberOfPayPeriods": 52,
"payperiodsRemaining": 42.0
},
{
"standardBenefitAreaId": "DENTAL",
"benefitOptionId": "DentalPPO",
"coverageLevelId": "PPFAM2",
"employeeMonthlyCost": 29.17,
"employerMonthlyCost": 125.0,
"benefitProgramId": "ProgH",
"beneficiaryCollection": "Not Applicable",
"maxCoverageAmount": 0.0,
"minCoverageAmount": 0.0,
"preTax": true,
"postTax": false,
"userDefinedTaxability": false,
"numberOfPayPeriods": 52,
"payperiodsRemaining": 42.0
}
],
"dependents": [
{
"fullName": "Allison Drew ",
"dependentId": "5d82c4bf-609d-4c2f-8c1b-7d8fdd8b9fde",
"relationshipType": "Spouse",
"birthDate": "1980-01-01",
"activeIndicator": true,
"approvedIndicator": true,
"studentIndicator": false,
"coverages": [
{
"standardBenefitAreaId": "DENTAL",
"benefitOptionId": "NoCoverageDental",
"dependentCoverageRequired": false,
"activeCourtOrdered": false
},
{
"standardBenefitAreaId": "MEDICAL",
"benefitOptionId": "NoCoverageMedical",
"dependentCoverageRequired": false,
"activeCourtOrdered": false
}
]
},
{
"fullName": "Adam Drew ",
"dependentId": "d3f97b64-4a50-4dea-bec8-51d3db39352a",
"relationshipType": "Child",
"birthDate": "2012-01-01",
"activeIndicator": true,
"approvedIndicator": true,
"studentIndicator": false,
"coverages": [
{
"standardBenefitAreaId": "DENTAL",
"benefitOptionId": "NoCoverageDental",
"dependentCoverageRequired": false,
"activeCourtOrdered": false
},
{
"standardBenefitAreaId": "MEDICAL",
"benefitOptionId": "NoCoverageMedical",
"dependentCoverageRequired": false,
"activeCourtOrdered": false
}
]
}
]
}
},
"changes": []
}
]
}
我目前正在使用来自https://github.com/VBA-tools/VBA-JSON的 VBA-JSON来解析 JSON。
JsonOptions.AllowUnquotedKeys = True
Set JSON = JsonConverter.ParseJson(jsonResponse)
最终，我希望访问参与者结果 | 资格结果 | 当前事件 | 资格详情和参与者结果 | 资格结果 | 当前事件 | 家属。我尝试使用以下方式开始遍历 JSON：
For Each Eligibility In JSON("participantEligibilityResults")
For Each Detail In Eligibility("eligibilityResult")
'DO SOMETHING HERE
Next
Next
不幸的是，一旦我在参与者资格结果级别进行解析，我就无法访问以下级别。我收到错误消息“对象不支持此属性或方法。” 有人可以指出我正确的方向吗？
解决方案
包含的所有{}内容都将作为字典输出，包含的所有内容都[]将是一个集合。您只需要按照嵌套即可到达您想要的位置。
Sub Test()
Dim result As String
Dim Item, a
Dim parsedResult As Object, obj, node, k
'loading from a cell for testing...
Set parsedResult = JsonConverter.ParseJson(Sheet2.Range("A1").Value)
Set obj = parsedResult("participantEligibilityResults")(1)("eligibilityResult")
Set node = obj("currentEvent")("eligibilityDetails")(1)
DumpJSon node 'see below
Set node = obj("currentEvent")("dependents")(1)
DumpJSon node 'see below
End Sub
如果有您想要的特定项目，那么尝试创建嵌套循环来获取它们可能不是很有用 - 确定您想要的路径并直接访问这些值。如果您需要（例如）循环一个集合，那么这需要成为您方法的一部分。
仔细检查解析结果中的内容有时很有用，因此您可以使用它来将其转储到即时窗口（全部或仅部分）
Sub DumpJSon(obj, Optional level As Long = 0)
Const LEVEL_STEP As Long = 5
Dim k, v, n, s, tmp
If TypeName(obj) = "Dictionary" Then
For Each k In obj.keys
s = String(level, "-") & k & " = "
If IsObject(obj(k)) Then
Debug.Print s & IIf(obj(k).Count = 0, "Empty ", "") & _
TypeName(obj(k))
DumpJSon obj(k), level + LEVEL_STEP
Else
Debug.Print s & obj(k)
End If
Next k
ElseIf TypeName(obj) = "Collection" Then
n = 1
For Each v In obj
s = String(level, "-") & "(Item #" & n & ") "
If IsObject(v) Then
Debug.Print s & IIf(v.Count = 0, "Empty ", "") & _
TypeName(v)
DumpJSon v, level + LEVEL_STEP
Else
Debug.Print s & v
End If
n = n + 1
Next v
End If
End Sub