VBA di Excel: ciclo object JSON analizzato

Per esempio di seguito … Il looping di un object da una stringa JSON analizzata restituisce un errore “L’object non supporta questa proprietà o metodo”. Qualcuno potrebbe consigliare come farlo funzionare? Molto apprezzato (ho passato 6 ore a cercare una risposta prima di chiedere qui).

Funzione per analizzare la stringa JSON in object (funziona correttamente).

Function jsonDecode(jsonString As Variant) Set sc = CreateObject("ScriptControl"): sc.Language = "JScript" Set jsonDecode = sc.Eval("(" + jsonString + ")") End Function 

Il ciclo attraverso l’object parsed restituisce l’errore “L’object non supporta questa proprietà o metodo”.

 Sub TestJsonParsing() Dim arr As Object 'Parse the json array into here Dim jsonString As String 'This works fine jsonString = "{'key1':'value1','key2':'value2'}" Set arr = jsonDecode(jsonString) MsgBox arr.key1 'Works (as long as I know the key name) 'But this loop doesn't work - what am I doing wrong? For Each keyName In arr.keys 'Excel errors out here "Object doesn't support this property or method" MsgBox "keyName=" & keyName MsgBox "keyValue=" & arr(keyName) Next End Sub 

PS. Ho già esaminato queste librerie:

vba-json Non è riuscito a far funzionare l’esempio.
– VBJSON Non è incluso lo script vba (potrebbe funzionare ma non sapere come caricarlo in Excel e c’è una documentazione minima).

Inoltre, è ansible accedere a array JSON analizzati multidimensionali? Solo ottenere un ciclo di array a dimensione singola funzionante sarebbe fantastico (scusate se chiedere troppo). Grazie.


Modifica: qui ci sono due esempi di lavoro che usano la libreria vba-json. La domanda di cui sopra è ancora un mistero però …

 Sub TestJsonDecode() 'This works, uses vba-json library Dim lib As New JSONLib 'Instantiate JSON class object Dim jsonParsedObj As Object 'Not needed jsonString = "{'key1':'val1','key2':'val2'}" Set jsonParsedObj = lib.parse(CStr(jsonString)) For Each keyName In jsonParsedObj.keys MsgBox "Keyname=" & keyName & "//Value=" & jsonParsedObj(keyName) Next Set jsonParsedObj = Nothing Set lib = Nothing End Sub Sub TestJsonEncode() 'This works, uses vba-json library Dim lib As New JSONLib 'Instantiate JSON class object Set arr = CreateObject("Scripting.Dictionary") arr("key1") = "val1" arr("key2") = "val2" MsgBox lib.toString(arr) End Sub 

L’object JScriptTypeInfo è un po ‘sfortunato: contiene tutte le informazioni rilevanti (come puoi vedere nella finestra di Watch ) ma sembra imansible raggiungerlo con VBA.

Se l’istanza di JScriptTypeInfo fa riferimento a un object Javascript, For Each ... Next non funzionerà. Tuttavia, funziona se si riferisce a un array Javascript (vedere la funzione GetKeys seguito).

Quindi la soluzione alternativa è di utilizzare nuovamente il motore Javascript per ottenere le informazioni che non possiamo con VBA. Prima di tutto, c’è una funzione per ottenere le chiavi di un object Javascript.

Una volta che conosci le chiavi, il prossimo problema è accedere alle proprietà. VBA non sarà di aiuto se il nome della chiave è noto solo in fase di esecuzione. Quindi ci sono due metodi per accedere a una proprietà dell’object, una per i valori e l’altra per gli oggetti e gli array.

 Option Explicit Private ScriptEngine As ScriptControl Public Sub InitScriptEngine() Set ScriptEngine = New ScriptControl ScriptEngine.Language = "JScript" ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } " ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } " End Sub Public Function DecodeJsonString(ByVal JsonString As String) Set DecodeJsonString = ScriptEngine.Eval("(" + JsonString + ")") End Function Public Function GetProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Variant GetProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName) End Function Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal propertyName As String) As Object Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, propertyName) End Function Public Function GetKeys(ByVal JsonObject As Object) As String() Dim Length As Integer Dim KeysArray() As String Dim KeysObject As Object Dim Index As Integer Dim Key As Variant Set KeysObject = ScriptEngine.Run("getKeys", JsonObject) Length = GetProperty(KeysObject, "length") ReDim KeysArray(Length - 1) Index = 0 For Each Key In KeysObject KeysArray(Index) = Key Index = Index + 1 Next GetKeys = KeysArray End Function Public Sub TestJsonAccess() Dim JsonString As String Dim JsonObject As Object Dim Keys() As String Dim Value As Variant Dim j As Variant InitScriptEngine JsonString = "{""key1"": ""val1"", ""key2"": { ""key3"": ""val3"" } }" Set JsonObject = DecodeJsonString(CStr(JsonString)) Keys = GetKeys(JsonObject) Value = GetProperty(JsonObject, "key1") Set Value = GetObjectProperty(JsonObject, "key2") End Sub 

Nota:

  • Il codice utilizza l’associazione anticipata. Quindi devi aggiungere un riferimento a “Microsoft Script Control 1.0”.
  • È necessario chiamare InitScriptEngine una volta prima di utilizzare le altre funzioni per eseguire InitScriptEngine base.

Risposta super semplice: grazie alla potenza di OO (o è javascript;) puoi aggiungere il metodo (n) dell’articolo che hai sempre desiderato!

la mia risposta completa qui

 Private ScriptEngine As ScriptControl Public Sub InitScriptEngine() Set ScriptEngine = New ScriptControl ScriptEngine.Language = "JScript" ScriptEngine.AddCode "Object.prototype.myitem=function( i ) { return this[i] } ; " Set foo = ScriptEngine.Eval("(" + "[ 1234, 2345 ]" + ")") ' JSON array Debug.Print foo.myitem(1) ' method case sensitive! Set foo = ScriptEngine.Eval("(" + "{ ""key1"":23 , ""key2"":2345 }" + ")") ' JSON key value Debug.Print foo.myitem("key1") ' WTF End Sub 

La risposta di Codo è grande e costituisce la spina dorsale di una soluzione.

Tuttavia, lo sapevate che CallByName di VBA consente di interrogare una struttura JSON. Ho appena scritto una soluzione su Google Places Dettagli su Excel con VBA per un esempio.

In realtà l’ho appena riscritto senza riuscire a usare le funzioni aggiunte a ScriptEngine come da questo esempio. Ho raggiunto il looping attraverso un array solo con CallByName.

Quindi alcuni esempi di codice per illustrare

 'Microsoft Script Control 1.0; {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx Option Explicit Sub TestJSONParsingWithVBACallByName() Dim oScriptEngine As ScriptControl Set oScriptEngine = New ScriptControl oScriptEngine.Language = "JScript" Dim jsonString As String jsonString = "{'key1':'value1','key2':'value2'}" Dim objJSON As Object Set objJSON = oScriptEngine.Eval("(" + jsonString + ")") Debug.Assert VBA.CallByName(objJSON, "key1", VbGet) = "value1" Debug.Assert VBA.CallByName(objJSON, "key2", VbGet) = "value2" Dim jsonStringArray As String jsonStringArray = "[ 1234, 4567]" Dim objJSONArray As Object Set objJSONArray = oScriptEngine.Eval("(" + jsonStringArray + ")") Debug.Assert VBA.CallByName(objJSONArray, "length", VbGet) = "2" Debug.Assert VBA.CallByName(objJSONArray, "0", VbGet) = "1234" Debug.Assert VBA.CallByName(objJSONArray, "1", VbGet) = "4567" Stop End Sub 

E fa anche oggetti secondari (oggetti nidificati) e vedi esempio di Google Maps su Google Places Dettagli su Excel con VBA

Come Json non è altro che stringhe quindi può essere facilmente gestito se possiamo manipolarlo nel modo giusto, non importa quanto sia complessa la struttura. Non penso sia necessario utilizzare alcuna libreria o convertitore esterno per fare il trucco. Ecco un esempio in cui ho analizzato i dati JSON usando la manipolazione delle stringhe.

 Sub Json_data() Const URL = "https://api.redmart.com/v1.5.8/catalog/search?extent=2&pageSize=6&sort=1&category=bakery" Dim http As New XMLHTTP60, html As New HTMLDocument Dim str As Variant With http .Open "GET", URL, False .send str = Split(.responseText, "category_tags"":") End With On Error Resume Next y = UBound(str) For i = 1 To y Cells(i, 1) = Split(Split(str(i), "title"":""")(1), """")(0) Cells(i, 2) = Split(Split(str(i), "sku"":""")(1), """")(0) Cells(i, 3) = Split(Split(str(i), "price"":")(1), ",")(0) Cells(i, 4) = Split(Split(str(i), "desc"":""")(1), """")(0) Next i End Sub 

So che è tardi, ma per coloro che non sanno come usare VBJSON , devi solo:

1) Importa JSON.bas nel tuo progetto (Apri Editor VBA, Alt + F11; File> Importa file)

2) Aggiungi dizionario riferimento / class Solo per Windows, includere un riferimento a “Microsoft Scripting Runtime”

È anche ansible utilizzare VBA-JSON allo stesso modo, che è specifico per VBA anziché VB6 e ha tutta la documentazione.