web-dev-qa-db-fra.com

Excel VBA: boucle d'objet JSON analysée

Par exemple ci-dessous ... La boucle dans un objet à partir d'une chaîne JSON analysée renvoie une erreur "L'objet ne prend pas en charge cette propriété ou cette méthode". Quelqu'un pourrait-il conseiller comment faire ce travail? Très apprécié (j'ai passé 6 heures à chercher une réponse avant de demander ici). 

Fonction pour analyser la chaîne JSON dans un objet (cela fonctionne bien).

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

La boucle dans l'objet analysé renvoie l'erreur "L'objet ne prend pas en charge cette propriété ou cette méthode".

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. J'ai déjà examiné ces bibliothèques:

- vba-json N'a pas réussi à donner l'exemple.
- VBJSON Il n'y a pas de script vba inclus (cela peut fonctionner mais vous ne savez pas comment le charger dans Excel et la documentation est minimale).

De plus, est-il possible d'accéder à des tableaux JSON analysés multidimensionnels? Obtenir simplement une boucle de tableau à une dimension fonctionnerait bien (désolé si vous en demandez trop). Merci. 

Edit: Voici deux exemples de travail utilisant la bibliothèque vba-json. La question ci-dessus reste cependant un mystère ...

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
jsonexcelvbascriptcontrol
20
rr789

L'objet JScriptTypeInfo est un peu fâcheux: il contient toutes les informations pertinentes (comme vous pouvez le voir dans la fenêtre Watch ), mais il semble impossible d'y parvenir avec VBA.

Si l'instance JScriptTypeInfo fait référence à un objet Javascript, For Each ... Next ne fonctionnera pas. Cependant, cela fonctionne s'il fait référence à un tableau Javascript (voir fonction GetKeys ci-dessous).

La solution consiste donc à utiliser à nouveau le moteur Javascript pour obtenir les informations que nous ne pouvons pas utiliser avec VBA. Tout d'abord, il existe une fonction pour obtenir les clés d'un objet Javascript. 

Une fois que vous connaissez les clés, le problème suivant consiste à accéder aux propriétés. VBA ne vous aidera pas non plus si le nom de la clé n'est connu qu'au moment de l'exécution. Il existe donc deux méthodes pour accéder à une propriété de l'objet, une pour les valeurs et l'autre pour les objets et les tableaux.

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

Remarque:

  • Le code utilise la liaison anticipée. Vous devez donc ajouter une référence à "Microsoft Script Control 1.0".
  • Vous devez appeler InitScriptEngine une fois avant d’utiliser les autres fonctions pour effectuer une initialisation de base.
29
Codo

Réponse Super Simple - grâce à la puissance de OO (ou s'agit-il de javascript;) Vous pouvez ajouter la méthode item (n) de votre choix!

ma réponse complète ici

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
3
ozmike

La réponse de Codo est excellente et constitue l’épine dorsale d’une solution.

Cependant, saviez-vous que CallByName de VBA vous amène assez loin dans l'interrogation d'une structure JSON. Je viens d'écrire une solution sur Google Places Details to Excel avec VBA pour un exemple.

En fait, il suffit de le réécrire sans parvenir à utiliser les fonctions ajoutant à ScriptEngine conformément à cet exemple. J'ai réussi à boucler un tableau avec CallByName uniquement.

Donc, quelques exemples de code pour illustrer

'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

Et il fait aussi des sous-objets (objets imbriqués) voir l'exemple de Google Maps à Google Adresses vers Excel avec VBA

3
S Meaden

Comme Json n’est que des chaînes, il est facile à manipuler si nous pouvons le manipuler correctement, quelle que soit la complexité de la structure. Je ne pense pas qu'il soit nécessaire d'utiliser une bibliothèque externe ou un convertisseur pour faire l'affaire. Voici un exemple où j'ai analysé des données JSON à l'aide d'une manipulation de chaîne.

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
1
SIM

Je sais qu'il est tard, mais pour ceux qui ne savent pas utiliser VBJSON , il vous suffit de:

1) Importez JSON.bas dans votre projet (Ouvrez l’éditeur VBA, Alt + F11; Fichier> Importer un fichier).

2) Ajouter une référence/classe de dictionnaire Pour Windows uniquement, inclure une référence à "Microsoft Scripting Runtime"

Vous pouvez également utiliser le VBA-JSON de la même manière, qui est spécifique à VBA au lieu de VB6 et contient toute la documentation.

0
Lionel T.