VBA中的json_encode

原创已于 2023-04-19 11:08:47 修改 · 1.1k 阅读

5 ·

本内容遵循CC 4.0 BY-SA版权协议

标签

#json #开发语言

于 2023-04-18 16:28:55 首次发布

本文介绍了在VBA中如何使用字典和递归算法来模拟PHP的json_encode功能，以生成JSON数据。虽然不如PHP的对象转换方便，但对于特定场景已足够。作者分享了自己的改进版代码，用于将VBA字典转换为JSON。

最近笔者写vba代码的时候需要将一组数据包装成json数据作为参数传递，然而网上搜索了一圈，并没有发现如PHP的json_encode，decode之类通用的方法。后来看到另外一位博主的文章，是利用字典+递归算法来实现（原文：在 VBA 中将对象转换为 JSON |），虽然对于笔者的场景来说已经够用了，但毕竟没达到php object那样便利，然而vba的字典本身是支持方便的object关联关系的，于是笔者强迫症犯了，尝试着做了一下改写，权作记录吧：

'将数组/dictionary转换为json字符串

'参数：object可以为普通数组、Dictionary或Dictionary数组，Dictionary为key-value键值对，value可以支持数字、字符串、普通数组、Dictionary或Dictionary数组，普通数组中可以是数字或者字符串

'参考来源：https://qa.1r1g.com/sf/ask/2314208291/

Function objToJson(ByVal object) As String
    
    Dim result As String
    If IsArray(object) Then
        result = "["
        For Each obj In object
            result = result & IIf(Len(result) > 1, ",", "")
            If TypeName(obj) = "Dictionary" Then
                objJson = objToJson(obj)
            ElseIf TypeName(obj) = "String" Then
                objJson = """" & obj & """"
            Else
                objJson = obj
            End If
            result = result & objJson
        Next
        result = result & "]"
    Else
        
        Dim key As Variant, value As Variant
        Set dict = object
        result = "{"
        For Each key In dict.keys
            If IsArray(dict(key)) Then
                result = result & IIf(Len(result) > 1, ",", "")
                result = result & """" & key & """:" & objToJson(dict(key))
            Else
                result = result & IIf(Len(result) > 1, ",", "")
        
                'Debug.Print TypeName(dict(key))
                If TypeName(dict(key)) = "Dictionary" Then
                    value = objToJson(dict(key))
                    'DicToJson = value
                Else
                    'Debug.Print TypeName(dict(key)) & ":" & dict(key)
                    If TypeName(dict(key)) = "String" Then
                        value = """" & dict(key) & """"
                    Else
                        value = dict(key)
                    End If
                End If
        
                result = result & """" & key & """:" & value & ""
            End If
        Next key
        result = result & "}"
    End If
    
    objToJson = result
End Function

以下是调试代码

Private Sub jsonTest()

    Dim obj As Dictionary
    Set obj = New Dictionary
    
    Dim subObj As Dictionary
    Set subObj = New Dictionary
    subObj.Add "key1", "value1"
    subObj.Add "key2", "value2"
    subObjArr = Array(subObj)
    supplierArr = Array("comp1", "comp2", "comp3")
    
    obj.Add "id", "12345"
    obj.Add "type", 2
    obj.Add "name", "商品1"
    obj.Add "price", 2.995
    obj.Add "qty", 2000
    obj.Add "suppliers", supplierArr
    obj.Add "time", Format(Now(), "yyyy-mm-dd hh:mm:ss")
    obj.Add "objectArr", subObjArr
    
    Dim obj2 As Dictionary
    Set obj2 = New Dictionary
    obj2.Add "id", "12346"
    obj2.Add "type", 2
    obj2.Add "name", "商品2"
    obj2.Add "price", 2.997
    obj2.Add "qty", 5000
    obj2.Add "suppliers", supplierArr
    obj2.Add "time", Format(Now(), "yyyy-mm-dd hh:mm:ss")
    obj2.Add "objectArr", subObjArr
    
    objarr = Array(obj, obj2)
    
    'jsonStr = objToJson(obj)   '单个obj
    jsonStr = objToJson(objarr) 'obj数组
    
    'jsonStr = objToJson(supplierArr)   '普通数组
    Debug.Print jsonStr
    
End Sub

运行结果：