在Windows上的Excel VBA中,如何为已解析的JSON变量获取字符串化

首先,我们承认Douglas Crockford是“Javascript：The Good Parts”(http://shop.oreilly.com/product/9780596517748.do)的作者
并且是javascript专家.所以我们很乐意在字符串化方面采用他的代码.我们可以使用简单的Xml HTTP请求获取他的代码
(通常缩写为XHR)并将返回结果传递给ScriptControl的AddCode方法.然后添加一些允许我们覆盖默认表示的代码
通过调用Douglas的库来获取“[object Object]”.然后确保我们动态地将覆盖添加到我们所有的JScriptTypeInfo变量,
我们用DecodeJsonString()包装的ScriptControl的Eval方法
以及我们用GetJSONObject()包装的VBA.CallByName.

从而,

'Tools->References->
'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:WindowsSysWOW64msscript.ocx
'Microsoft Xml,v6.0

Option Explicit

Private Function GetScriptEngine() As ScriptControl
    Static soScriptEngine As ScriptControl
    If soScriptEngine Is Nothing Then
        Set soScriptEngine = New ScriptControl
        soScriptEngine.Language = "JScript"

        soScriptEngine.AddCode GetJavaScriptLibrary("https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js")
        soScriptEngine.AddCode "function overrideToString(jsonObj) { jsonObj.toString = function() { return JSON.stringify(this); } }"
    End If
    Set GetScriptEngine = soScriptEngine
End Function

Private Function GetJavaScriptLibrary(ByVal sURL As String) As String

    Dim xHTTPRequest As MSXML2.XMLHTTP60
    Set xHTTPRequest = New MSXML2.XMLHTTP60
    xHTTPRequest.Open "GET",sURL,False
    xHTTPRequest.send
    GetJavaScriptLibrary = xHTTPRequest.responseText

End Function

Private Function DecodeJsonString(ByVal JsonString As String) As Object
    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = GetScriptEngine

    Set DecodeJsonString = oScriptEngine.Eval("(" + JsonString + ")")

    Call oScriptEngine.Run("overrideToString",DecodeJsonString) '* this gives JSON rendering instead of "[object Object]"

End Function

Private Function GetJSONObject(ByVal obj As Object,ByVal sKey As String) As Object
    Dim objReturn As Object
    Set objReturn = VBA.CallByName(obj,sKey,VbGet)
    Call GetScriptEngine.Run("overrideToString",objReturn) '* this gives JSON rendering instead of "[object Object]"
    Set GetJSONObject = objReturn
End Function

Private Sub TestJSONParsingWithCallByName2()

    Dim sJsonString As String
    sJsonString = "{'key1': 'value1','key2': { 'key3': 'value3' } }"


    Dim objJSON As Object
    Set objJSON = DecodeJsonString(sJsonString)

    Stop


    Dim objKey2 As Object
    Set objKey2 = GetJSONObject(objJSON,"key2")
    Debug.Print objKey2
    Stop

End Sub

下面是一个新代码的屏幕截图,其中显示了JScriptTypeInfo变量的字符串化