2 votes

VBA-Json Analyser le Json imbriqué

Merci à @QHarr d'avoir travaillé sur ce projet avec moi !

Mon objectif est de récupérer les valeurs de chacune des catégories imbriquées dans les "commandes".

mon json :

{
  "total": 14,
  "_links": {
    "next": {
      "href": "/api/my/orders/selling/all?page=2&per_page=1"
    }
  },
  "orders": [
    {
      "amount_product": {
        "amount": "0.01",
        "currency": "USD",
        "symbol": "$"
      },
      "amount_product_subtotal": {
        "amount": "0.01",
        "currency": "USD",
        "symbol": "$"
      },
      "shipping": {
        "amount": "0.00",
        "currency": "USD",
        "symbol": "$"
      },
      "amount_tax": {
        "amount": "0.00",
        "currency": "USD",
        "symbol": "$"
      },
      "total": {
        "amount": "0.01",
        "currency": "USD",
        "symbol": "$"
      },
      "buyer_name": "Some Buyer",
      "created_at": "2015-02-03T04:38:03-06:00",
      "order_number": "434114",
      "needs_feedback_for_buyer": false,
      "needs_feedback_for_seller": false,
      "order_type": "instant",
      "paid_at": "2015-02-03T04:38:04-06:00",
      "quantity": 1,
      "shipping_address": {
        "name": "Some Buyer",
        "street_address": "1234 Main St",
        "extended_address": "",
        "locality": "Chicagoj",
        "region": "IL",
        "postal_code": "60076",
        "country_code": "US",
        "phone": "1231231234"
      },
      "local_pickup": false,
      "shop_name": "Some Seller",
      "status": "refunded",
      "title": "DOD Stereo Chorus Extreme X GFX64",
      "updated_at": "2015-03-06T11:59:27-06:00",
      "payment_method": "direct_checkout",
      "_links": {
        "photo": {
          "href": "https://reverb-res.cloudinary.com/image/upload/a_exif,c_thumb,f_auto,fl_progressive,g_south,h_192,w_192/v1386717988/h1zpe0sii9my0xm55htd.jpg"
        },
        "feedback_for_buyer": {
          "href": "/api/orders/434114/feedback/buyer"
        },
        "feedback_for_seller": {
          "href": "/api/orders/434114/feedback/seller"
        },
        "listing": {
          "href": "/api/listings/47096"
        },
        "start_conversation": {
          "href": "/api/my/conversations?listing_id=47096&recipient_id=302456"
        },
        "self": {
          "href": "/api/my/orders/selling/434114"
        },
        "mark_picked_up": {
          "href": "/api/my/orders/selling/434114/mark_picked_up"
        },
        "ship": {
          "href": "/api/my/orders/selling/434114/ship"
        },
        "contact_buyer": {
          "web": {
            "href": "https://reverb.com/my/messages/new?item=47096-dod-stereo-chorus-extreme-x-gfx64&to=302456-yan-p-5"
          }
        }
      },
      "photos": [
        {
          "_links": {
            "large_crop": {
              "href": "https://reverb-res.cloudinary.com/image/upload/a_exif,c_thumb,f_auto,fl_progressive,g_south,h_640,q_85,w_640/v1386717988/h1zpe0sii9my0xm55htd.jpg"
            },
            "small_crop": {
              "href": "https://reverb-res.cloudinary.com/image/upload/a_exif,c_thumb,f_auto,fl_progressive,g_south,h_296,q_85,w_296/v1386717988/h1zpe0sii9my0xm55htd.jpg"
            },
            "full": {
              "href": "https://reverb-res.cloudinary.com/image/upload/a_exif,c_limit,f_auto,fl_progressive,h_1136,q_75,w_640/v1386717988/h1zpe0sii9my0xm55htd.jpg"
            },
            "thumbnail": {
              "href": "https://reverb-res.cloudinary.com/image/upload/a_exif,c_thumb,f_auto,fl_progressive,g_south,h_192,w_192/v1386717988/h1zpe0sii9my0xm55htd.jpg"
            }
          }
        }
      ],
      "sku": "rev-47096",
      "selling_fee": {
        "amount": "0.00",
        "currency": "USD",
        "symbol": "$"
      },
      "direct_checkout_payout": {
        "amount": "-0.24",
        "currency": "USD",
        "symbol": "$"
      }
    }
  ]
}

Si j'ai un bon exemple de la façon de travailler avec les données imbriquées, je suis sûr que je peux faire en sorte que cela fonctionne. Voici mon code actuel, il ne fonctionne pas... voici l'erreur - "l'objet ne supporte pas cette propriété ou méthode" sur cette ligne : For Each Amount_Product In Orders("amount_product"). Ce que j'attends, c'est de pouvoir extraire la valeur de chacun des "articles" de amount_product et de les pousser dans des variables afin de pouvoir ensuite les pousser dans une table.

Dim Json As Object

Dim FSO As New FileSystemObject
Dim JsonTS As TextStream
Dim JsonText As String

Dim Parsed As Dictionary

'set up variables to receive the values
Dim sAmount As String
Dim sCurrency As String
Dim sSymbol As String

'Read .json file
Set JsonTS = FSO.OpenTextFile("somefilepath.txt", ForReading)
JsonText = JsonTS.ReadAll
JsonTS.Close

'came from https://github.com/VBA-tools/VBA-JSON

Set Parsed = JsonConverter.ParseJson(JsonText)

Dim Values As Variant

Dim Orders As Dictionary
Dim NestedValue As Dictionary
Dim i As Long

i = 0
For Each Orders In Parsed("orders")
    For Each NestedValue In Orders("amount_product")
        sAmount = (Values(i, 0) = NestedValue("amount"))
        sCurrency = (Values(i, 1) = NestedValue("currency"))
        sSymbol = (Values(i, 2) = NestedValue("symbol"))

            i = i + 1
    Next NestedValue
Next Orders  

J'ai également essayé ceci - d'après certains exemples de code que j'ai trouvés, cela ne fonctionne pas non plus :

For Each NestedValue In Parsed("orders")(1)("amount_product")

      sAmount = (Values(i, 0) = NestedValue("amount"))
      sCurrency = (Values(i, 1) = NestedValue("currency"))
      sSymbol = (Values(i, 2) = NestedValue("symbol"))

        i = i + 1

Next NestedValue

J'ai essayé d'utiliser ceci VBA Analyser le JSON imbriqué exemple de @TimWilliams mais je n'ai pas réussi à le modifier pour qu'il fonctionne avec mon Json. Même erreur, "object doesn't support this property or method" sur la ligne "For Each NestedValue In Parsed("orders")(1)("amount_product")".

2voto

QHarr Points 24420

Ok résolu (Oops.... je pense !). Voici donc deux versions traitant du même JSON.

Version 1 : Un exemple simple vous montrant comment obtenir le Amount_Product les valeurs que vous recherchiez. Ce n'est pas la syntaxe la plus facile à lire, mais j'ai donné les longues descriptions/syntaxe dans la version 2.

Version 2 : Extraction de toutes les valeurs du JSON.

Exigences supplémentaires pour la mise en place :

1) Référence nécessaire au MS Scripting Runtime dans VBE > Outils > Références

References

2) Module JSON Converter par Tim Hall

Processus :

J'ai utilisé TypeName(object) à chaque étape, pour comprendre quels objets étaient renvoyés par le JSON. J'ai laissé certains d'entre eux (commentés en tant que Debug.Print ) afin que vous ayez une idée de ce qui se passe à chaque étape.

Observations :

1) JsonConverter.ParseJson(JsonText) renvoie un dictionnaire à Parsed .

2) Parsed("orders") renvoie une collection contenant un seul dictionnaire, c'est-à-dire initialCollection(1)

3) Que dictionnaire peut contenir une variété d'objets, ce qui est peut-être ce qui prête à confusion.

Si vous exécutez la commande suivante, pour consulter les objets du dictionnaire :

Debug.Print  TypeName(initialDict(key))

Vous découvrez que c'est un petit dictionnaire bien rempli. Il héberge les éléments suivants :

  • Booléen * 3
  • Collection * 1
  • Dictionnaire * 9
  • Double * 1
  • Chaîne * 11

Et donc, bien sûr, vous continuez à explorer des niveaux plus profonds de l'imbrication via ces structures. Les différentes manipulations, en fonction du type de données, que j'ai effectuées par l'intermédiaire de Select Case . J'ai essayé de garder la terminologie assez simple.

Comment utiliser un analyseur syntaxique JSON en ligne pour examiner la structure :

Il y a donc un certain nombre de analyseurs JSON en ligne là-bas.

Vous placez votre code dans la fenêtre de gauche (de l'exemple que j'ai donné) et la fenêtre de droite montre l'évaluation :

JSON parser

Si vous regardez le rouge initial "[" ; c'est l'objet de collection que vous obtenez avec Parsed("orders") .

Collection object

Alors vous pouvez voir le premier "{" avant le "amount_product" qui est votre premier dictionnaire dans la collection.

First dictionary within the collection

Et dans ce cadre, associé à "amount_product" id, est le prochain dictionnaire où vous voyez le prochain "{"

Next dictionary

Vous savez donc que vous devez récupérer la collection, puis potentiellement itérer sur deux dictionnaires pour obtenir le premier ensemble de valeurs qui vous intéresse.

J'ai utilisé un raccourci avec Parsed("orders")(1)("amount_product").Keys ,dans le premier exemple de code, pour accéder à ce dictionnaire interne sur lequel il faut itérer.

Résultats :

Results print out

Code :

Version 1 (simple) :

Option Explicit

Public Sub test1()

    Dim Json As Object
    Dim FSO As New FileSystemObject
    Dim JsonTS As TextStream
    Dim JsonText As String

    Set JsonTS = FSO.OpenTextFile("C:\Users\User\Desktop\Document.txt", ForReading)
    JsonText = JsonTS.ReadAll
    JsonTS.Close

    Dim Parsed As Dictionary 'or As Object if not including reference to scripting runtime reference in library
    Set Parsed = JsonConverter.ParseJson(JsonText)

    Dim key As Variant
    Dim sAmount As String 'Assume you will keep these as strings?
    Dim sCurrency As String
    Dim sSymbol As String

    For Each key In Parsed("orders")(1)("amount_product").Keys

        Dim currentString As String
        currentString = Parsed("orders")(1)("amount_product")(key)

        Select Case key

        Case "amount"

            sAmount = currentString

        Case "currency"

            sCurrency = currentString

        Case "symbol"

            sSymbol = currentString

        End Select

        Debug.Print key & ": " & currentString

    Next key

End Sub

Version 2 : tout reprendre. Plus descriptif.

Option Explicit

Sub test2()

    Dim Json As Object
    Dim FSO As New FileSystemObject
    Dim JsonTS As TextStream
    Dim JsonText As String

    Set JsonTS = FSO.OpenTextFile("C:\Users\User\Desktop\Document.txt", ForReading) 'change as appropriate
    JsonText = JsonTS.ReadAll
    JsonTS.Close

    Dim Parsed As Dictionary

    Set Parsed = JsonConverter.ParseJson(JsonText)

    Dim initialCollection  As Collection

    Set initialCollection = Parsed("orders")

    ' Debug.Print initialCollection.Count ' 1 item which is a dictionary

    Dim initialDict As Dictionary

    Set initialDict = initialCollection(1)

    Dim key As Variant
    Dim dataStructure As String

    For Each key In initialDict.Keys

        dataStructure = TypeName(initialDict(key))

        Select Case dataStructure

        Case "Dictionary"

        Dim Key1 As Variant

        For Each Key1 In initialDict(key).Keys

           Select Case TypeName(initialDict(key)(Key1))

           Case "String"

              Debug.Print key & " " & Key1 & " " & initialDict(key)(Key1) 'amount/currency/symbol

           Case "Dictionary"

               Dim Key2 As Variant

               For Each Key2 In initialDict(key)(Key1).Keys

                   'Debug.Print TypeName(initialDict(key)(Key1)(Key2)) 'strings and one dict

                   Select Case TypeName(initialDict(key)(Key1)(Key2))

                       Case "String"

                           Debug.Print key & " " & Key1 & " " & Key2 & " " & initialDict(key)(Key1)(Key2)

                       Case "Dictionary"

                            Dim Key3 As Variant

                            For Each Key3 In initialDict(key)(Key1)(Key2).Keys

                                'Debug.Print TypeName(initialDict(key)(Key1)(Key2)(Key3)) 'string only
                                Debug.Print initialDict(key)(Key1)(Key2)(Key3)

                            Next Key3

                   End Select

               Next Key2

           Case Else

               MsgBox "Oops I missed this one"

           End Select

        Next Key1

        Case "String", "Boolean", "Double"

           Debug.Print key & " : " & initialDict(key)

        Case "Collection"

            'Debug.Print TypeName(initialDict(key)(1)) 'returns  1  Dict
            Dim Key4 As Variant

            For Each Key4 In initialDict(key)(1).Keys   'Debug.Print TypeName(initialDict(key)(1)(Key4)) 'returns a dictionary

                Dim Key5 As Variant

                For Each Key5 In initialDict(key)(1)(Key4).Keys ' Debug.Print TypeName(initialDict(key)(1)(Key4)(Key5)) returns 4 dictionaries

                   Dim Key6 As Variant

                   For Each Key6 In initialDict(key)(1)(Key4)(Key5).Keys 'returns string

                       Debug.Print key & "  " & Key4 & "  " & Key5 & "  " & Key6 & " " & initialDict(key)(1)(Key4)(Key5)(Key6)

                   Next Key6

                Next Key5

            Next Key4

        Case Else

            MsgBox "Oops I missed this one!"

        End Select

    Next key

End Sub

Observation finale :

Par souci de cohérence et pour faciliter la démonstration de ce qui se passe, j'ai ajouté tous les éléments suivants .Keys mais il n'est pas nécessaire, lorsque l'on itère dans un fichier For Each Boucle sur un dictionnaire, pour mettre .Keys comme le montre le test ci-dessous et le gif intégré :

Option Explicit

Private Sub test()

    Dim testDict As Dictionary
    Set testDict = New Dictionary

    testDict.Add "A", 1
    testDict.Add "B", 2

    Dim key As Variant

    For Each key In testDict
        Debug.Print key & ":" & testDict(key)
    Next key

End Sub

Donc, par exemple :

For Each key In initialDict.Keys => For Each key In initialDict

0voto

CTrim Points 23

J'ai combiné V1 et V2 ci-dessus pour produire les résultats, qui consistaient à capturer des valeurs et à les enregistrer dans des variables. Voici mon code modifié : (Je travaille encore à la création de tous les cas et variables)

    Dim Json As Object
    Dim FSO As New FileSystemObject
    Dim JsonTS As TextStream
    Dim JsonText As String

    Set JsonTS = FSO.OpenTextFile("C:\some.txt", ForReading) 'change as appropriate
    JsonText = JsonTS.ReadAll
    JsonTS.Close

    Dim Parsed As Dictionary

    Set Parsed = JsonConverter.ParseJson(JsonText)

    Dim initialCollection  As Collection

    Set initialCollection = Parsed("orders")

    Debug.Print initialCollection.Count ' 1 item which is a dictionary

    Dim initialDict As Dictionary

    Set initialDict = initialCollection(1)

    Dim Key As Variant
    Dim dataStructure As String

    For Each Key In initialDict.Keys

        dataStructure = TypeName(initialDict(Key))

        Select Case dataStructure

        Case "Dictionary"

        Dim Key1 As Variant

        For Each Key1 In initialDict(Key).Keys

           Select Case TypeName(initialDict(Key)(Key1))

           Case "String"

              'Debug.Print Key & " " & Key1 & " " & initialDict(Key)(Key1) 'amount/currency/symbol

                        'because the Key1 (amount) is the same for each Key ("Amount_product", "Amount_product_subtotal", and so on; (see Json above) I needed to concatenate them to extract unique values
                        Select Case Key & "_" & Key1

                        'first set of values "Amount_Product"
                        Case "Amount_product_amount"

                            dAmount_product_amount = initialDict(Key)(Key1)

                        Case "Amount_product_currency"

                            sAmount_product_currency = initialDict(Key)(Key1)

                        Case "Amount_product_symbol"

                            sAmount_product_symbol = initialDict(Key)(Key1)

                        'second set of values "Amount_Product_Subtotal"

                        Case "Amount_product_subtotal_amount"

                            dAmount_product_subtotal_amount = initialDict(Key)(Key1)

                        Case "Amount_product_subtotal_currency"

                            sAmount_product_subtotal_currency = initialDict(Key)(Key1)

                        Case "Amount_product_subtotal_symbol"

                            sAmount_product_subtotal_symbol = initialDict(Key)(Key1)

                        ' third set of values, and so on

                        End Select

                        'Debug.Print Key & ": " & Key1

           Case "Dictionary"

               Dim Key2 As Variant

               For Each Key2 In initialDict(Key)(Key1).Keys

                   'Debug.Print TypeName(initialDict(key)(Key1)(Key2)) 'strings and one dict

                   Select Case TypeName(initialDict(Key)(Key1)(Key2))

                       Case "String"

                           Debug.Print Key & " " & Key1 & " " & Key2 & " " & initialDict(Key)(Key1)(Key2)

                       Case "Dictionary"

                            Dim Key3 As Variant

                            For Each Key3 In initialDict(Key)(Key1)(Key2).Keys

                                'Debug.Print TypeName(initialDict(key)(Key1)(Key2)(Key3)) 'string only
                                Debug.Print initialDict(Key)(Key1)(Key2)(Key3)

                            Next Key3

                   End Select

               Next Key2

           Case Else

               MsgBox "Oops I missed this one"

           End Select

        Next Key1

        Case "String", "Boolean", "Double"

           Debug.Print Key & " : " & initialDict(Key)

        Case "Collection"

            'Debug.Print TypeName(initialDict(key)(1)) 'returns  1  Dict
            Dim Key4 As Variant

            For Each Key4 In initialDict(Key)(1).Keys   'Debug.Print TypeName(initialDict(key)(1)(Key4)) 'returns a dictionary

                Dim Key5 As Variant

                For Each Key5 In initialDict(Key)(1)(Key4).Keys ' Debug.Print TypeName(initialDict(key)(1)(Key4)(Key5)) returns 4 dictionaries

                   Dim Key6 As Variant

                   For Each Key6 In initialDict(Key)(1)(Key4)(Key5).Keys 'returns string

                       Debug.Print Key & "  " & Key4 & "  " & Key5 & "  " & Key6 & " " & initialDict(Key)(1)(Key4)(Key5)(Key6)

                   Next Key6

                Next Key5

            Next Key4

        Case Else

            MsgBox "Oops I missed this one!"

        End Select

    Next Key

End Sub

Prograide.com

Prograide est une communauté de développeurs qui cherche à élargir la connaissance de la programmation au-delà de l'anglais.
Pour cela nous avons les plus grands doutes résolus en français et vous pouvez aussi poser vos propres questions ou résoudre celles des autres.

Powered by:

X