VBA-Json Parse Nested Json

Question

Thank you to @QHarr for working on this with me!

My goal is to grab the values for each of the nested categories from "orders"

my 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": "$"
      }
    }
  ]
}

If I have one good example of how to work with the nested data I am sure I can get this to work. This is my current code, it doesn't work... this is the error- "the object doesn't support this property or method" on this line: For Each Amount_Product In Orders("amount_product"). What I am expecting is to be able to extract the value of each of the amount_product "items" and push them into variables so that I can then push them into a 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  

I also tried this- based on some examples of code I have found, this doesn't work either:

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

I tried using this VBA Parse Nested JSON example by @TimWilliams but was not successful in tweaking it to work with my Json. Same error, "object doesn't support this property or method" on the line "For Each NestedValue In Parsed("orders")(1)("amount_product")"

Answer 1

Ok solved (Oops....I think!). So, here are two versions dealing with the same JSON.

Version 1: A simple example showing you how to get the Amount_Product values you were after. Not the easiest to read syntax, but I have given the lengthy descriptions/syntax in version 2.

Version 2: Extracting all the values from the JSON.

Additional set-up requirements:

1) Reference required to MS Scripting Runtime in VBE > Tools > References

2) JSON Converter module by Tim Hall

Process:

I used TypeName(object) , at each stage, to understand which objects were being returned from the JSON. I have left some of these in (commented out as Debug.Print statements) so you have an idea what is going on at each stage.

Observations:

1) JsonConverter.ParseJson(JsonText) returns a dictionary to Parsed.

2) Parsed("orders") returns a collection which holds a single dictionary i.e. initialCollection(1)

3) That dictionary holds a variety of objects which is perhaps what is rather confusing.

If you run the following, to look at the objects in the dictionary:

Debug.Print  TypeName(initialDict(key))

You discover what a busy little dictionary it is. It hosts the following:

• Boolean * 3
• Collection * 1
• Dictionary * 9
• Double * 1
• String * 11

And so of course you keep delving into deeper levels of the nesting via these structures. The different handling, according to datatype, I have done via Select Case. I have tried to keep the terminology fairly straight forward.

How to use an Online JSON parser to examine structure:

So there are a number of online JSON parsers out there.

You pop your code in the left window (of the example I have given) and the right window shows the evaluation:

If you look at the initial red "[" ; this is the collection object you are getting with Parsed("orders").

Then you can see the first "{" before the "amount_product" which is your first dictionary within the collection.

And within that, associated with "amount_product" id, is the next dictionary where you see the next "{"

So you know you have to get the collection and then potentially iterate over two dictionaries to get the first set of values you were interested in.

I used a shortcut with Parsed("orders")(1)("amount_product").Keys ,in the first code example, to get to this inner dictionary to iterate over.

Results:

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: Grab everything. More descriptive.

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

Final observation:

To be consistent, and to aid demonstrating what is going on, I have added all the .Keys, but it is unnecessary, when iterating in a For Each Loop over a Dictionary, to put .Keys, as shown in test below and in the embedded gif:

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

So for example:

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

Answer 2

I combined V1 and V2 above to produce the results, which was to capture values and save them into variables. This is my edited code: (I am still working on creating all of the cases and 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