In Excel VBA on Windows, how to get stringified JSON respresentation instead of "[object Object]" for parsed JSON variables?
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
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