Search code examples
jsonvbadictionaryms-access

Editing values in a nested dictionary using .Items property with variable keys


I have a nested dictionary created using the VBA-JSON library. For the moment at least it is a dictionary with an arbitrary number of subdictionaries and items in an arbitrary organization, no collections or other objects. Below is a sample of the JSON I'm working with.

{
  "Product": {
    "Name": "Delta 14in Bandsaw",
    "Model#": "258-40",
    "Catalog#": "10XXXX",
    "Dimensions": {
      "DimMM": {
        "Height": "1500",
        "Width": "400",
        "Depth": "300"
      }
    }
  }
}

I need to be able to access the value of each member in the dictionary and subdictionaries and update it individually. I figured the .Item property of Dictionaries would work for this.

dict("Product")("Dimensions")("DimMM").item("Height") = "1500"
path = "Product"
itemPath = "Name"
dict(path).item(itemPath) = "Delta 14in Bandsaw"

Both of the examples above work great, however I can't find a way to use a variable for the entire dictionary path when there is an arbitrary number of nested dictionaries

a = "Product"
b = "Dimensions"
c = "DimMM"
d = "Height"

Parsed(a)(b)(c).item(d) = "1500"

The above also works, but doesn't help me much when I need to construct this path on the fly for an arbitrary depth.

I initially thought that I could construct a string to use as the path, something like below (there are some syntax issues I know, my actual approach to this involved Join and constants to represent double quotes)

pString = "("Product")("Dimensions")("DimMM")"
itemPath = "Height"
dict(pString).item(itemPath) = "1500"

No version of the string approach worked, I get Error 424: Object Required. I quickly realized that the string approach wouldn't work as it is looking for an object name and ("Product")("Dimensions")("DimMM") is three object names as a string, not one.

I feel like I am missing something very obvious here, how can I construct the object name to input to the .Item property on the fly? Am I approaching this poorly in general? Are there other more straightforward methods of updating dictionary members?


Solution

  • You could do something like this:

    Sub Tester()
    
        Dim json As Object
        
        Set json = JsonConverter.ParseJson(Range("A1").Value)
        
        Debug.Print JsonValue(json, "Product/Name")                     '>> Delta 14in Bandsaw
        Debug.Print JsonValue(json, "Product/Dimensions/DimMM/Height")  '>> 1500
        JsonValue json, "Product/Dimensions/DimMM/Height", 1600         'set new value
        Debug.Print JsonValue(json, "Product/Dimensions/DimMM/Height")  '>> 1600
        
    End Sub
    
    'read/set the value of a key at the end of a json path
    Function JsonValue(json, path As String, Optional v = Empty)
        Dim obj As Object, el As String, arr, i As Long
        Set obj = json
        arr = Split(path, "/") 'split path to an array
        For i = LBound(arr) To UBound(arr) - 1
            Set obj = obj(arr(i)) 'assign next object in path
        Next i
        JsonValue = obj(arr(UBound(arr))) 'return current value (key is last item in array)
        If Not IsEmpty(v) Then obj(arr(UBound(arr))) = v 'optionally update the value if a new value was passed
    End Function
    

    (only tested with nested dictionaries - might need adjustments if you also need to deal with collections/arrays)