Excel VBA: Bucle de objetos JSON analizados

scriptcontrol

Question

Por ejemplo a continuación ... El bucle a través de un objeto desde una cadena JSON analizada devuelve un error "El objeto no admite esta propiedad o método". ¿Alguien podría aconsejar cómo hacer que esto funcione? Muy apreciado (pasé 6 horas buscando una respuesta antes de preguntar aquí).

Función para analizar cadenas JSON en objetos (esto funciona bien).

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

El bucle a través del objeto analizado devuelve el error "El objeto no admite esta propiedad o método".

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

PD. Miré en estas bibliotecas ya:

- vba-json No fue capaz de hacer funcionar el ejemplo.
- VBJSON No se incluyen secuencias de comandos vba (esto podría funcionar, pero no sabe cómo cargarlo en Excel y hay documentación mínima).

Además, ¿es posible acceder a matrices JSON analizadas multidimensionales? Solo obtener un bucle de matriz de una dimensión trabajando sería genial (lo siento si se pide demasiado). Gracias.

Editar: Aquí hay dos ejemplos de trabajo usando la biblioteca vba-json. La pregunta anterior sigue siendo un misterio, aunque ...

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

Answer 1

Como Json no es más que cuerdas, puede manejarse fácilmente si podemos manipularlo de la manera correcta, sin importar cuán compleja sea la estructura. No creo que sea necesario utilizar una biblioteca externa o un convertidor para hacer el truco. Aquí hay un ejemplo en el que he analizado datos JSON utilizando la manipulación de cadenas.

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

Answer 2

El objeto JScriptTypeInfo es un poco desafortunado: contiene toda la información relevante (como se puede ver en la ventana Inspección ) pero parece imposible acceder a ella con VBA.

Si la instancia de JScriptTypeInfo hace referencia a un objeto de Javascript, For Each ... Next no funcionará. Sin embargo, funciona si se refiere a una matriz Javascript (vea la función GetKeys continuación).

Entonces, la solución es volver a utilizar el motor de Javascript para obtener la información que no podemos con VBA. En primer lugar, hay una función para obtener las claves de un objeto Javascript.

Una vez que conozca las claves, el siguiente problema es acceder a las propiedades. VBA tampoco ayudará si el nombre de la clave solo se conoce en tiempo de ejecución. Entonces, hay dos métodos para acceder a una propiedad del objeto, uno para los valores y el otro para los objetos y las matrices.

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:

• El código usa enlace anticipado. Por lo tanto, debe agregar una referencia a "Microsoft Script Control 1.0".
• InitScriptEngine invocar InitScriptEngine una vez antes de usar las otras funciones para realizar una inicialización básica.

Answer 3

La respuesta de Codo es excelente y constituye la columna vertebral de una solución.

Sin embargo, sabías que CallByName de VBA te lleva bastante lejos al consultar una estructura JSON. Acabo de escribir una solución en Detalles de Google Places para Excel con VBA como ejemplo.

En realidad, simplemente lo reescribió sin lograr usar las funciones que agregan a ScriptEngine según este ejemplo. Logré un bucle a través de una matriz con CallByName solamente.

Entonces, algún código de muestra para ilustrar

''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

Y también hace subobjetos (objetos anidados), vea el ejemplo de Google Maps en Detalles de Google Places para Excel con VBA

Answer 4

Respuesta súper simple: mediante el poder de OO (o es javascript;) ¡Puede agregar el método de artículo (n) que siempre quiso!

mi respuesta completa aquí

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

Answer 5

Sé que es tarde, pero para aquellos que no saben cómo usar VBJSON , solo tienes que:

1) Importe JSON.bas en su proyecto (Abra VBA Editor, Alt + F11; Archivo> Importar archivo)

2) Agregar referencia / clase de diccionario Para Windows solamente, incluya una referencia a "Microsoft Scripting Runtime"

También puede usar VBA-JSON la misma manera, que es específico para VBA en lugar de VB6 y tiene toda la documentación.