VBA - 使用递归从 JSON 创建 MSAccess 关系表

Posted 2023-03-23

【中文标题】VBA - 使用递归从 JSON 创建 MSAccess 关系表

【英文标题】：VBA - Create MSAccess relational tables from JSON using recursion

【发布时间】：2021-06-14 23:09:31

【问题描述】：

在使用各种不同的方法解决这个问题几天后，我终于意识到我可能已经咬得比我能咀嚼的多。我有一个结构为字典集合的 JSON 提取。这是一个相当复杂的结构，但每个字典在整个 JSON 中都是一致的。我正在尝试做的是递归遍历 JSON，构建和链接表。我已经接近了，但我的递归遇到了一些问题。为简单起见，所有字段都是字符串。

JSON 在字典集合中的结构如下：

 Dictionary 1.0
      key/value pair 1a
      key/value pair 1b
      key/value pair 1c
      subDictionary 1.1
          key/value pair 1.1a
          key/value pair 1.1b
          key/value pair 1.1c
     subDictionary 1.2
          key/value pair 1.2a
          key/value pair 1.2b
          key/value pair 1.2c

 Dictionary 2.0
      key/value pair 2a
      key/value pair 2b
      key/value pair 2c
      subDictionary 2.1
          key/value pair 2.1a
          key/value pair 2.1b
          key/value pair 2.1c
     subDictionary 2.2
          key/value pair 2.2a
          key/value pair 2.2b
          key/value pair 2.2c

我最终想要的是一个父/子关系数据库，其中包含两个（或可能更多）由 ID 链接的表：

 Parent Table
 ID     Field 1a     Field 1b     Field 1c 
 1.0    Value 1a      Value 1b     Value 1c
 2.0    Value 2a      Value 2b     Value 2c

 Sub Table
 parentID  ID     key1.1a        key1.1b       key1.1c
 1.0       1.1    Value 1.1a     Value 1.1b    Value 1.1c
 1.0       1.2    Value 1.2a     Value 1.2b    Value 1.2c
 2.0       2.1    Value 2.1a     Value 2.1b    Value 2.1c
 2.0       2.2    Value 2.2a     Value 2.2b    Value 2.2c

到目前为止，我的代码可以进行递归，但我还需要它来构建 SQL 语句来定义表和填充数据。我知道这是一个很大的问题，但我认为很多人会在这段代码中发现将 JSON 导入 MS Access 关系表的价值。我目前正在将数据加载到 2D 数组中，但我的下一步是构建多个 2D 数组（每个表一个）或直接构建 SQL 语句以构建新表并将其链接到数据元素，并且完全忘记构建数组。

我从我的主程序中获取 JSON 字符串并对其进行解析：

  sub Main
       Dim strResult As Variant

       Set strResult = JsonConverter.ParseJson([add your json string here])
       ReDim BuildArray(strResult.Count, 1) As String

       ColNum = 0
       RowNum = 1        'Row 0 is used to hold the field names

       Call TraverseDictionary(strResult, RowNum, ColNum, BuildArray)

  end sub



 Private Sub TraverseDictionary(myDictionary As Variant, RowNum As Integer, ColNum As Integer, BuildArray As Variant)
    Dim key As Variant
    Dim myObject As Variant
    Dim myElement As String

    Select Case TypeName(myDictionary)

    Case "Dictionary"

        For Each key In myDictionary.Keys
        
            If TypeName(key) <> "Dictionary" And TypeName(key) <> "Collection" Then
                
                BuildArray(0, ColNum) = Trim(key)
                ColNum = ColNum + 1
                If ColNum > UBound(BuildArray, 2) Then
                    ReDim Preserve BuildArray(UBound(BuildArray, 1), ColNum)
                End If
            Else
                Debug.Print "Table = ", myDictionary.Keys(1)
                ArrFieldType.Add TypeName(key) & " - Case Dictionary"
            End If
            
            TraverseDictionary myDictionary(key), RowNum, ColNum, BuildArray
            
        Next key

    Case "Collection"
    
        For Each key In myDictionary
        
            If TypeName(key) <> "Dictionary" And TypeName(key) <> "Collection" Then
                BuildArray(0, ColNum) = Trim(key)
                ColNum = ColNum + 1
                If ColNum > UBound(BuildArray, 2) Then
                    ReDim Preserve BuildArray(UBound(BuildArray, 1), ColNum)
                End If
            Else
                
                myElement = CStr(key(1))
                ArrFieldType.Add TypeName(key) & " - Case Collection"
                
            End If
            
            TraverseDictionary key, RowNum, ColNum, BuildArray, ArrFieldType
        
        Next
        
        If ColNum > 0 Then
            RowNum = RowNum + 1
            ColNum = 0
        End If
    
       Case Else
                
                If IsNull(myDictionary) Then
                    myElement = ""
                Else
                    myElement = CStr(myDictionary)
                End If
                
                BuildArray(RowNum, ColNum) = myElement
                
     End Select


 End Sub

有人愿意提供一些指导吗？提前致谢。一旦我让递归工作，我想实现

中描述的方法

 https://***.com/questions/62437764/importing-json-file-to-ms-access-table

创建将构建和填充表的 SQL 语句，并创建索引。

结果将是一个小函数，它将接受几乎任何 JSON 片段并将其转换为 MS Access 链接表。

【参考方案1】：

我没有使用字典，而是集合，因为它们是 Access 原生的。

这种方式递归拆分接收到的Json相对容易。一个例子是模块 JsonCollection 在这里找到：

VBA.CVRAPI

诀窍是检查节点持有什么；如果它是一个集合，则更深一层。

要创建表、索引和关系，您应该使用DAO。它比你最终得到的 SQL 和 ALTER 表和字段的混乱要干净得多。一个例子是模块 WtziData 在这里找到：

VBA.Timezone-Windows

【讨论】：

感谢您的反馈！ :-) 我做了一些测试，发现我收到的 JSON 字符串被格式化为字典集合，其中一些元素是嵌套字典。我同意使用 DAO。这个问题变得复杂的地方是我是否应该逐步遍历整个 json 以确定结构（构建数组导致由于 redim 导致的性能问题，然后将数组转换为表）还是在逐步执行时动态构建（构建表，添加列，并通过 SQL 创建关系）。这两种方法各有利弊。

我认为我会做两步，首先浏览整个结构 - 至少这会在早期发现错误。