求编写生成指定结构JSON文件的Excel VBA代码

以下提供两种实现方式，分别适配简单固定场景和可扩展场景：

方式一：字符串拼接（适合简单固定结构） #

直接拼接JSON字符串，代码简洁，适合结构固定、无需动态修改的场景：

Sub GenerateGSTJSON()
    Dim jsonStr As String
    Dim savePath As String
    
    ' 构建目标JSON字符串
    jsonStr = "{" & vbCrLf & _
        "    ""Version"": ""1.1""," & vbCrLf & _
        "    ""TranDtls"": {" & vbCrLf & _
        "        ""TaxSch"": ""GST""," & vbCrLf & _
        "        ""SupTyp"": ""B2B""," & vbCrLf & _
        "        ""IgstOnIntra"": ""N""," & vbCrLf & _
        "        ""RegRev"": ""N""," & vbCrLf & _
        "        ""EcmGstin"": null" & vbCrLf & _
        "    }," & vbCrLf & _
        "    ""DocDtls"": {" & vbCrLf & _
        "        ""Typ"": ""INV""," & vbCrLf & _
        "        ""No"": ""1""," & vbCrLf & _
        "        ""Dt"": ""21/10/2022""" & vbCrLf & _
        "    }" & vbCrLf & _
        "}"
    
    ' 指定JSON文件保存路径（默认存放在当前Excel文件同目录下）
    savePath = ThisWorkbook.Path & "\GST_Document.json"
    
    ' 将JSON字符串写入文件
    Open savePath For Output As #1
    Print #1, jsonStr
    Close #1
    
    MsgBox "JSON文件已生成，路径：" & savePath, vbInformation
End Sub

动态修改说明 #

如果需要从Excel单元格读取值替换JSON内容，比如把文档编号换成A1单元格的值，只需修改对应片段：

""No"": """ & Range("A1").Value & """"

方式二：Dictionary对象构建（适合可扩展场景） #

用Dictionary对象搭建JSON结构，更易维护和扩展，适合后续需要添加字段或嵌套结构的场景：

' 注意：需先引用Microsoft Scripting Runtime库
' 操作步骤：打开VBA编辑器 → 工具 → 引用 → 勾选"Microsoft Scripting Runtime"
Sub GenerateGSTJSONWithDictionary()
    Dim mainDict As New Dictionary
    Dim tranDtlsDict As New Dictionary
    Dim docDtlsDict As New Dictionary
    Dim jsonStr As String
    Dim savePath As String
    
    ' 构建TranDtls子结构
    tranDtlsDict.Add "TaxSch", "GST"
    tranDtlsDict.Add "SupTyp", "B2B"
    tranDtlsDict.Add "IgstOnIntra", "N"
    tranDtlsDict.Add "RegRev", "N"
    tranDtlsDict.Add "EcmGstin", "null" ' VBA无原生null，用字符串"null"替代
    
    ' 构建DocDtls子结构
    docDtlsDict.Add "Typ", "INV"
    docDtlsDict.Add "No", "1"
    docDtlsDict.Add "Dt", "21/10/2022"
    
    ' 构建主JSON结构
    mainDict.Add "Version", "1.1"
    mainDict.Add "TranDtls", tranDtlsDict
    mainDict.Add "DocDtls", docDtlsDict
    
    ' 将Dictionary转换为格式化的JSON字符串
    jsonStr = ConvertDictToJSON(mainDict)
    
    ' 指定保存路径
    savePath = ThisWorkbook.Path & "\GST_Document.json"
    
    ' 写入文件
    Open savePath For Output As #1
    Print #1, jsonStr
    Close #1
    
    MsgBox "JSON文件已生成，路径：" & savePath, vbInformation
End Sub

' 自定义函数：将Dictionary转换为JSON字符串
Function ConvertDictToJSON(dict As Dictionary) As String
    Dim key As Variant
    Dim jsonSegments As Collection
    Set jsonSegments = New Collection
    
    For Each key In dict.Keys
        If TypeName(dict(key)) = "Dictionary" Then
            ' 递归处理嵌套的子Dictionary
            jsonSegments.Add """" & key & """: " & ConvertDictToJSON(dict(key))
        Else
            ' 处理普通键值对
            jsonSegments.Add """" & key & """: """ & dict(key) & """"
        End If
    Next key
    
    ' 拼接所有片段并添加格式缩进
    ConvertDictToJSON = "{" & vbCrLf & "    " & JoinCol(jsonSegments, "," & vbCrLf & "    ") & vbCrLf & "}"
End Function

' 辅助函数：将Collection内容拼接为字符串
Function JoinCol(col As Collection, delimiter As String) As String
    Dim i As Integer
    Dim result As String
    
    For i = 1 To col.Count
        If i > 1 Then result = result & delimiter
        result = result & col(i)
    Next i
    
    JoinCol = result
End Function

内容的提问来源于stack exchange，提问作者Ziyad VK