Excel VBA: Bucle de objeto JSON analizado

Nuestro team de expertos luego de muchos días de trabajo y recopilar de información, hallamos los datos necesarios, nuestro deseo es que te sea útil para tu proyecto.

Solución:

los JScriptTypeInfo El objeto es un poco desafortunado: contiene toda la información relevante (como puede ver en el Reloj ventana) pero parece imposible llegar a él con VBA.

Si el JScriptTypeInfo instancia se refiere a un objeto Javascript, For Each ... Next no funcionará Sin embargo, funciona si se refiere a un Javascript array (ver GetKeys función a continuación).

Entonces, la solución es usar nuevamente el motor Javascript para obtener la información que no podemos con VBA. En primer lugar, hay una función para obtener el keys de un objeto Javascript.

Una vez que sepas el keys, el siguiente problema es acceder a las propiedades. VBA tampoco ayudará si el nombre del key solo se conoce en tiempo de ejecución. Entonces, hay dos métodos para acceder a una propiedad del objeto, uno para valores y otro para objetos y 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 utiliza enlace anticipado. Por lo tanto, debe agregar una referencia a “Microsoft Script Control 1.0”.
• tienes que llamar InitScriptEngine una vez antes de usar las otras funciones para realizar una inicialización básica.

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

Sin embargo, ¿sabías que VBA Llamar por nombre 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, solo lo reescribí sin lograr usar las funciones que se agregan a ScriptEngine según este ejemplo. Logré recorrer un array solo con CallByName.

Entonces, un código de muestra para ilustrar

'Microsoft Script Control 1.0;  0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC; C:WindowsSysWOW64msscript.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 tiene subobjetos (objetos anidados), vea el ejemplo de Google Maps en Google Places Details to Excel with VBA

EDITAR: no use Eval, intente analizar JSON de manera más segura, vea esta publicación de blog

Respuesta súper simple: a través del poder de OO (o es javascript;) ¡Puede agregar el método de elemento (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

Calificaciones y comentarios

Si te gusta la programación, tienes la opción de dejar una noticia acerca de qué te ha impresionado de esta crónica.

---

---

Utiliza Nuestro Buscador