In Excel VBA su Windows, come ottenere rappresentazioni JSON con stringa anziché "[oggetto oggetto]" per le variabili JSON analizzate?

Question

rispondendo alla mia domanda qui.
Ho fatto qualche lavoro con JSON in Excel VBA e un sacco di risultati per pubblicare che lo farò in Q & Un formato https://stackoverflow.com/help/self-answerhttp://blog.stackoverflow.com/2011/07/its-ok-to-ask-and-answer-your-own-questions/

Così altrove su StackOverflow si può vedere domande su analisi JSON in VBA, ma sembra mancare un trucco o due.

Per cominciare, resisto dall'uso di librerie di analisi JSON personalizzate e invece utilizzo il metodo Eval di ScriptControl come base di tutto il mio codice JSON. E inoltre esprimiamo una preferenza dalle soluzioni Microsoft native.

Ecco una domanda precedente In Excel VBA on Windows, how to mitigate issue of dot syntax traversal of parsed JSON broken by IDE's capitalisation behaviour? su cui viene generata questa domanda. Mostra come l'utilizzo di VBA.CallByName è più efficace di rispetto all'utilizzo della sintassi del punto per attraversare un oggetto JSON analizzato. Un'altra domanda precedente In Excel VBA on Windows, how to loop through a JSON array parsed? mostra come è possibile utilizzare per accedere agli elementi dell'array. Ma CallByName restituisce un curioso tipo di variabile che appare in Watch window come Object/JScriptTypeInfo e se si digita Debug.Print nella finestra immediata (o si passa sopra la variabile) si ottiene il non informativo "[oggetto oggetto]".

Come possiamo migliorare e ottenere una rappresentazione con stringa JSON?

Ecco uno screenshot di ciò che si vede in Windows immediato dopo un Debug.Print (?) E se si passa il mouse su una variabile.

Questo è Domanda 3 della serie di 5. Ecco la serie completa

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”?

012.351.641,061 mila

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

Answer 1

risposte ad altre domande di overflow dello stack che si riferiscono al lavoro con gli oggetti JSON parsed utilizzare un approccio mini-script e siamo in grado di utilizzare questo approccio qui.

In primo luogo riconosciamo che Douglas Crockford è autore di "Javascript: The Good Parts" (http://shop.oreilly.com/product/9780596517748.do) ed è esperto di JavaScript. Quindi siamo felici di adottare il suo codice per quanto riguarda la stringificazione. Possiamo ottenere il suo codice con una semplice richiesta HTTP Xml (comunemente abbreviata in XHR) e passare il risultato di ritorno al metodo AddCode di ScriptControl. Quindi aggiungi un codice che ci consenta di ignorare la rappresentazione predefinita di "[oggetto oggetto]" chiamando nella libreria di Douglas. E quindi assicurati di aggiungere dinamicamente tale sovrascrittura a tutte le nostre variabili JScriptTypeInfo, , sia ciò che esce dal metodo Eval di ScriptControl che avvolgiamo con DecodeJsonString() sia quello che esce da VBA.CallByName che viene inserito in GetJSONObject().

Così,

'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 

Ecco uno screenshot con il nuovo codice che mostra una in stringa delle variabili JScriptTypeInfo

Answer 2

Grazie s Meaden, questo è quello che cercavo , un modo semplice per convertire oggetti JSON in stringhe. Ho usato le tue idee e l'ho fuso con il mio codice, ma non mi piaceva l'idea di creare una connessione e scaricare lo script ogni volta che mi serviva per creare un oggetto JSON. quindi ho compresso il codice JSON2.js in una funzione e l'ho usato invece che sto incollando dopo forse a qualcuno piacerà anche l'idea.

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