希望有人作为我解决问题的一点暗示。
我有这样的Json响应：
"modules": [
{
"localId": "598d58882e00008b1174fa0a",
"legs": [
{
"markerIndex": 0,
"localId": "5a2ec9db250000cc0189fbac",
"connections": [
{
"jsonClass": "TransitCO",
"localId": "5a882b0b26000039187fd0bb",
{
"localId": "598d58c82c00005411c4a7e1",
"returnConnections": [
{
"jsonClass": "ActivityElementCO",
"localId": "5a8aeacc250000641c1d389a",
{
"localId": "598d58d62e0000a71174fa0c",
"legs": [
{
"markerIndex": 1,
"localId": "5a85c668200000ea1b040503",
"connections": [
{
"jsonClass": "TransitCO",
"localId": "5a882b0b26000039187fd0be",
我可以通过调用找到1 localId：
Dim fd As Integer
Set var_dmc = JsonConverter.ParseJson(MyDMC.ResponseText)
Set dmc = Worksheets("dmc")
fd = 25
For Each item In var_dmc("modules")(1)("legs")
dmc.Cells(fd, 2) = item("connections")("localId")
fd = fd + 1
Next
现在我的VBA代码应该读出“connections”下的每个“localId”IF“jsonClass”= TransitCO。
尝试与“如果那么”的每一个和组合，但没有任何作用。
有任何想法吗？
亲切的问候，克里斯
这是一个冗长的答案。 JSON中有很多空结构（可能是由于编辑。但我已经编码显示你仍然可以访问但是已经注释掉了许多这些部分。注释掉的typename语句是为了向你展示正在构建的结构在每个阶段返回。
不可否认，这是目前的一切，所以我会期待更短的版本。
注意：我正在从桌面上的文件中读取JSON。
为了更好地理解这一点，请参阅我对question.的回答
Option Explicit
Sub GetValues()
'Tools references > ms scripting runtime
Dim FSO As FileSystemObject
Set FSO = New FileSystemObject
Dim JsonTS As TextStream
Dim JsonText As String
Set JsonTS = FSO.OpenTextFile(ThisWorkbook.Path & Application.PathSeparator & "SOQuestion.txt", ForReading)
JsonText = JsonTS.ReadAll
JsonTS.Close
Dim Json As Object
Set Json = ParseJson(JsonText)
Dim col As Collection
Set col = Json("modules")
'Debug.Print col.Count '3 items
Dim item As Variant
Dim key1 As Variant
Dim item1 As Variant
Dim key2 As Variant
For Each item In col
For Each key1 In item.Keys
If key1 = "localId" Then
Debug.Print key1 & " : " & item(key1)
ElseIf key1 = "legs" Then 'collection
For Each item1 In item(key1)
'Debug.Print TypeName(item1) '2 dict
For Each key2 In item1.Keys
' Debug.Print TypeName(item1(key2)) ' 2 collection; 2 dict; 4 double; 6 string
Dim dataStructure As String
dataStructure = TypeName(item1(key2))
Select Case dataStructure
Case "Double", "String"
Debug.Print key1 & " : " & key2 & item1(key2)
Case "Dictionary"
Dim key3 As Variant
For Each key3 In item1(key2).Keys
'Debug.Print item1(key2)(key3) 'This is empty
Next key3
Case "Collection" ' 2 collections with 1 item which are both dictionaries
Dim key4 As Variant
For Each key4 In item1(key2)(1).Keys
'Debug.Print TypeName(item1(key2)(1)(key4)) ' 1 boolean; 2 collection ; 2 dict; 8 strings
Dim dataStructure2 As String
dataStructure2 = TypeName(item1(key2)(1)(key4))
Select Case dataStructure2
Case "Boolean", "String"
Debug.Print key1 & " : " & key2 & " : " & key4 & " : " & item1(key2)(1)(key4)
Case "Collection" 'These are empty. As seen with Debug.Print item1(key2)(1)(key4).Count
' Dim item2 As Variant
'
' For Each item2 In item1(key2)(1)(key4)
'
' ' Debug.Print TypeName(item1(key2)(1)(key4)(item2)) 'empty
' 'Debug.Print key1 & " : " & key2 & " : " & key4 & " : " & item1(key2)(1)(key4)(item2)
'
' Next item2
Case "Dictionary" 'these are empty
'Dim key5 As Variant
'Debug.Print item1(key2)(1)(key4).Count = 0; so; both; Empty
' For Each key5 In item1(key2)(1)(key4).Keys
'
' Debug.Print TypeName(item1(key2)(1)(key4)(key5))
'
' Next key5
End Select
Next key4
End Select
Next key2
Next item1
End If
Next key1
Next item
End Sub
更懒散，不太健壮，有针对性的版本：
Option Explicit
Sub GetvaluesDict()
'Tools references > ms scripting runtime
Dim FSO As FileSystemObject
Set FSO = New FileSystemObject
Dim JsonTS As TextStream
Dim JsonText As String
Set JsonTS = FSO.OpenTextFile(ThisWorkbook.Path & Application.PathSeparator & "SOQuestion.txt", ForReading)
JsonText = JsonTS.ReadAll
JsonTS.Close
Dim Json As Object
Set Json = ParseJson(JsonText)
Dim col As Collection
Set col = Json("modules")
Dim counter As Long
Dim dict As Dictionary
Set dict = New Dictionary
Dim item As Variant
For Each item In col 'looking at items
Dim key1 As Variant
For Each key1 In item.Keys
If key1 = "returnConnections" Or key1 = "legs" Then '6 collections
Dim item1 As Variant
For Each item1 In item(key1) ' 6 dictionaries
Dim key2 As Variant
For Each key2 In item1.Keys
Dim dataStructure As String
dataStructure = TypeName(item1(key2))
Select Case dataStructure
Case "Double", "String", "Boolean"
counter = counter + 1
dict.Add counter, key1 & " : " & key2 & " : " & item1(key2)
Case "Collection"
Dim item2 As Variant
For Each item2 In item1(key2)
Dim key3 As Variant
For Each key3 In item2.Keys
Select Case TypeName(item2(key3))
Case "String"
counter = counter + 1
dict.Add counter, key1 & " : " & key2 & " : " & key3 & " : " & item2(key3)
End Select
Next key3
Next item2
End Select
Next key2
Next item1
End If
Next key1
Next item
Dim returns As Variant
counter = 1
For Each returns In dict.Keys
If InStr(1, dict(returns), "TransitCO", vbBinaryCompare) > 0 Then
Debug.Print dict(returns) & vbTab & dict(counter + 1)
End If
counter = counter + 1
Next returns
End Sub