In Excel VBA on Windows, how to get stringified JSON respresentation instead of “[object Object]” for parsed JSON variables?

后端 未结 2 1603
遇见更好的自我
遇见更好的自我 2020-12-03 15:49

answering my own question here.
I have done some work with JSON in Excel VBA and lots of findings to post which I will do so in Q & A format https://stackoverflow.co

相关标签:
2条回答
  • 2020-12-03 16:36

    Answers to other stack overflow question that relate to working with parsed JSON objects use a mini-script approach and we can use this approach here.

    Firstly we acknowledge that Douglas Crockford is author of 'Javascript: The Good Parts' (http://shop.oreilly.com/product/9780596517748.do) and is javascript expert. So we are happy to adopt his code with regard to stringification. We can get his code with a simple Xml HTTP Request (commonly shortened to XHR) and pass the return result to ScriptControl's AddCode method. Then add some code that allows us to override the default representation of "[object Object]" by calling into Douglas's library. AND then make sure we dynamically add that override to all our JScriptTypeInfo variables, both what comes out of ScriptControl's Eval method which we wrap with DecodeJsonString() and also what comes out of VBA.CallByName which we wrap with GetJSONObject().

    Thus,

    'Tools->References->
    'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.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
    

    Here is a screenshot with the new code which shows a stringification of the JScriptTypeInfo variables

    0 讨论(0)
  • 2020-12-03 16:49

    Thank you S Meaden, this is what I was looking for, a simple way to convert JSON object to string. I used your ideas and merged it with my code, but I did not like the idea of making a connection and downloading the script each time I needed to create a JSON object. so I compressed the JSON2.js code into a function and used it instead which I am pasting next maybe someone will like the idea too.

    Private Function JSON2() As String
        'https://stackoverflow.com/questions/37711073/in-excel-vba-on-windows-how-to-get-stringified-json-respresentation-instead-of
        'https://raw.githubusercontent.com/douglascrockford/JSON-js/master/json2.js
        JSON2 = _
            "if(typeof JSON!==""object""){JSON={};}" _
            & "(function(){""use strict"";var rx_one=/^[\],:{}\s]*$/;var rx_two=/\\(?:[""\\\/bfnrt]|u[0-9a-fA-F]{4})/g;var rx_three=/""[^""\\\n\r]*""|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g;var rx_four=/(?:^|:|,)(?:\s*\[)+/g;var rx_escapable=/[\\""\u0000-\u001f\u007f-\u009f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g;var rx_dangerous=/[\u0000\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g;function f(n){return n<10?""0""+n:n;}" _
            & "function this_value(){return this.valueOf();}" _
            & "if(typeof Date.prototype.toJSON!==""function""){Date.prototype.toJSON=function(){return isFinite(this.valueOf())?this.getUTCFullYear()+""-""+" _
            & "f(this.getUTCMonth()+1)+""-""+" _
            & "f(this.getUTCDate())+""T""+" _
            & "f(this.getUTCHours())+"":""+" _
            & "f(this.getUTCMinutes())+"":""+" _
            & "f(this.getUTCSeconds())+""Z"":null;};Boolean.prototype.toJSON=this_value;Number.prototype.toJSON=this_value;String.prototype.toJSON=this_value;}" _
            & "var gap;var indent;var meta;var rep;function quote(string){rx_escapable.lastIndex=0;return rx_escapable.test(string)?""\""""+string.replace(rx_escapable,function(a){var c=meta[a];return typeof c===""string""?c:""\\u""+(""0000""+a.charCodeAt(0).toString(16)).slice(-4);})+""\"""":""\""""+string+""\"""";}" _
            & "function str(key,holder){var i;var k;var v;var length;var mind=gap;var partial;var value=holder[key];if(value&&typeof value===""object""&&typeof value.toJSON===""function""){value=value.toJSON(key);}" _
            & "if(typeof rep===""function""){value=rep.call(holder,key,value);}"
        JSON2 = JSON2 _
            & "switch(typeof value){case""string"":return quote(value);case""number"":return isFinite(value)?String(value):""null"";case""boolean"":case""null"":return String(value);case""object"":if(!value){return""null"";}" _
            & "gap+=indent;partial=[];if(Object.prototype.toString.apply(value)===""[object Array]""){length=value.length;for(i=0;i<length;i+=1){partial[i]=str(i,value)||""null"";}" _
            & "v=partial.length===0?""[]"":gap?""[\n""+gap+partial.join("",\n""+gap)+""\n""+mind+""]"":""[""+partial.join("","")+""]"";gap=mind;return v;}" _
            & "if(rep&&typeof rep===""object""){length=rep.length;for(i=0;i<length;i+=1){if(typeof rep[i]===""string""){k=rep[i];v=str(k,value);if(v){partial.push(quote(k)+(gap?"": "":"":"")+v);}}}}else{for(k in value){if(Object.prototype.hasOwnProperty.call(value,k)){v=str(k,value);if(v){partial.push(quote(k)+(gap?"": "":"":"")+v);}}}}" _
            & "v=partial.length===0?""{}"":gap?""{\n""+gap+partial.join("",\n""+gap)+""\n""+mind+""}"":""{""+partial.join("","")+""}"";gap=mind;return v;}}" _
            & "if(typeof JSON.stringify!==""function""){meta={""\b"":""\\b"",""\t"":""\\t"",""\n"":""\\n"",""\f"":""\\f"",""\r"":""\\r"",""\"""":""\\\"""",""\\"":""\\\\""};JSON.stringify=function(value,replacer,space){var i;gap="""";indent="""";if(typeof space===""number""){for(i=0;i<space;i+=1){indent+="" "";}}else if(typeof space===""string""){indent=space;}" _
            & "rep=replacer;if(replacer&&typeof replacer!==""function""&&(typeof replacer!==""object""||typeof replacer.length!==""number"")){throw new Error(""JSON.stringify"");}" _
            & "return str("""",{"""":value});};}" _
            & "if(typeof JSON.parse!==""function""){JSON.parse=function(text,reviver){var j;function walk(holder,key){var k;var v;var value=holder[key];if(value&&typeof value===""object""){for(k in value){if(Object.prototype.hasOwnProperty.call(value,k)){v=walk(value,k);if(v!==undefined){value[k]=v;}else{delete value[k];}}}}" _
            & "return reviver.call(holder,key,value);}" _
            & "text=String(text);rx_dangerous.lastIndex=0;if(rx_dangerous.test(text)){text=text.replace(rx_dangerous,function(a){return""\\u""+" _
            & "(""0000""+a.charCodeAt(0).toString(16)).slice(-4);});}" _
            & "if(rx_one.test(text.replace(rx_two,""@"").replace(rx_three,""]"").replace(rx_four,""""))){j=eval(""(""+text+"")"");return(typeof reviver===""function"")?walk({"""":j},""""):j;}" _
            & "throw new SyntaxError(""JSON.parse"");};}}());"
    End Function
    
    0 讨论(0)
提交回复
热议问题