问VBA分析多个值
EN

Stack Overflow用户

提问于 2020-03-03 07:05:25

回答 1查看 371关注 0票数 1

我在使用带有多个值键的JSON转换器时遇到了问题。

我有为导航JSON树而编写的普通递归例程，但是这里有一个简单的JSON解析示例，我似乎无法工作。

看看这个VBA转换软件，它是非常棒和快速的。

环境： Windows 7/ Access 2016 /专用局域网(无互联网)

下面是代码：

Option Compare Database
Option Explicit

Sub testparse()
Dim js As String, i As Long, jo As Object, item As Variant
Dim keys(), vals()

' fails on this string
js = "{ !Category!: !Famous Pets!," & _
  "!code!: [!a!,!b!,!c!] }"            ' string with multiple values

' with the following string, this works
js = "{ !Category!: !Famous Pets!," & _
  "    !code!: !singlecodevalue! }"

js = Replace(js, "!", Chr(34)) ' replace ! with quotes

Debug.Print " js = " & js
Set jo = JsonConverter.ParseJson(js) ' returns object with json elements
i = 0
ReDim keys(1 To jo.Count)
ReDim vals(1 To jo.Count)

Debug.Print " Number keys found at top level " & jo.Count
For Each item In jo
    i = i + 1
    keys(i) = item
    vals(i) = jo(item)
    Next item

For i = 1 To jo.Count
    Debug.Print "key " & keys(i) & " = " & vals(i)
    Next i

End Sub

json

vba

parsing

回答 1

Stack Overflow用户

发布于 2020-03-03 08:51:02

对于在JSON对象中运行时遇到的每一项，您必须确定所处理的是什么--特别是如果您不提前知道数组中有多少项！如果您有一个带有数组内部集合的复合JSON结构，那么它就会变得更加棘手。

底线是，您必须检查从JSON对象中提取的每一项，并在访问JSON对象之前找出它是什么。JSON对象的顶层(假设使用JsonConverter)总是一个Dictionary。因此，您可以指望通过顶级字典的键循环：

Dim json As Dictionary
Set json = JsonConverter.ParseJson(someJsonString)

Dim topLevelKey As String
For Each topLevelKey In json
    Dim item As Variant
    Debug.Print topLevelKey & " = " & item
Next topLevelKey

问题是，item并不总是一个简单的字符串。它可以是值(String)、数组(Collection)或组(Dictionary)。将这个答案看作是一个很好的参考。

基本上，这意味着您必须在使用每个item之前检查它。所以你可以这样检查它：

Select Case TypeName(item)
    Case "Collection"
        '--- loop through the item as a Collection
    Case "Dictionary"
        '--- loop through the item as a Dictionary
    Case Else
        '--- the item is a value of some type (String, Boolean, etc)
End Select

在这里的示例中，我创建了一个名为ParseItem的子程序，它以这种方式检查每个项。将原始代码重新工作到下面的示例中：

Option Explicit

Sub testparse()
    Dim js As String, i As Long, jo As Object, item As Variant
    Dim keys(), vals()

    ' fails on this string
    js = "{ !Category!: !Famous Pets!," & _
         "!code!: [!a!,!b!,!c!] }"               ' string with multiple values

    ' with the following string, this works
    '    js = "{ !Category!: !Famous Pets!," & _
    '         "    !code!: !singlecodevalue! }"

    '--- compound example
    '    js = "{ !Category!: !Famous Pets!,!code!: [!a!,!b!,{!c! : { !c1! : !1!, !c2!:!2!}}] }"

    js = Replace(js, "!", Chr(34))               ' replace ! with quotes

    Debug.Print "----------------------"
    Debug.Print "js = " & js
    Set jo = JsonConverter.ParseJson(js)         ' returns object with json elements
    ParseDictionary 1, "root", jo
End Sub

Private Sub ParseCollection(ByVal level As Long, _
                            ByVal key As String, _
                            ByRef jsonCollection As Variant)
    Dim item As Variant
    For Each item In jsonCollection
        ParseItem level, key, item
    Next item
End Sub

Private Sub ParseDictionary(ByVal level As Long, _
                            ByVal key As String, _
                            ByRef jsonDictionary As Variant)
    Dim dictKey As Variant
    For Each dictKey In jsonDictionary
        ParseItem level, dictKey, jsonDictionary(dictKey)
    Next dictKey
End Sub

Private Sub ParseItem(ByVal level As Long, _
                      ByVal key As String, _
                      ByRef item As Variant)
    Select Case TypeName(item)
    Case "Collection"
        Debug.Print Format(level + 1, "00 ") & key & " (collection)"
        ParseCollection (level + 1), key, item
    Case "Dictionary"
        Debug.Print Format(level + 1, "00 ") & key & " (dictionary)"
        ParseDictionary (level + 1), key, item
    Case Else
        Debug.Print Format(level, "00 ") & key & " = " & item
    End Select
End Sub