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

Question

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.com/help/self-answer https://blog.stackoverflow.com/2011/07/its-ok-to-ask-and-answer-your-own-questions/

So elsewhere on stackoverflow one can see questions about parsing JSON in VBA but they seem to miss a trick or two.

To begin with, I resile from using custom JSON parsing libraries and instead use the ScriptControl's Eval method as the basis of all my JSON code. And also we express a preference from native Microsoft solutions.

Here is a prior question In Excel VBA on Windows, how to mitigate issue of dot syntax traversal of parsed JSON broken by IDE's capitalisation behaviour? upon which this question builds. It shows how using VBA.CallByName is more robust than using the dot syntax to traverse a parsed JSON object. Also another prior question In Excel VBA on Windows, how to loop through a JSON array parsed? shows how it also can be used to access array elements. But CallByName returns a curious variable type that appears in Watch window as Object/JScriptTypeInfo and if one type Debug.Print in the immediate window (or hovers over the variable) one gets the uninformative "[object Object]".

How can we improve on this and get a JSON stringified represenation?

Here is a screenshot of what you see in Immediate windows after a Debug.Print (?) and if you hover over a variable.

This is Question 3 of series of 5. Here is the full series

Q1 In Excel VBA on Windows, how to mitigate issue of dot syntax traversal of parsed JSON broken by IDE's capitalisation behaviour?

Q2 In Excel VBA on Windows, how to loop through a JSON array parsed?

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

Q4 In Windows Excel VBA,how to get JSON keys to pre-empt “Run-time error '438': Object doesn't support this property or method”?

Q5 In Excel VBA on Windows, for parsed JSON variables what is this JScriptTypeInfo anyway?

Answer 1

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

Answer 2

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