Parsing JSON (US BLS) in VBA from MS Access, update - json

Question

So, I had previously asked a question that was successfully answered (here: Parsing JSON (US BLS) in VBA from MS Access)
The new response I get that differs from the original question is that I've added a request to capture calculations. I've tried adding as a collection and scripting dictionary like footnotes but I see the format is not quite the same, and therefore I think it results in null when I try to gather the 1,3,6 and 12 month changes. I'd like to have some help figuring out how to capture those changes in the following response:
{
"status":"REQUEST_SUCCEEDED",
"responseTime":64,
"message":["BLS does not produce net change calculations for Series WPU381103"],
"Results":
{
"series":
[
{
"seriesID":"WPU381103",
"data":
[
{
"year":"2014",
"period":"M12",
"periodName":"December",
"value":"98.9",
"footnotes":
[
{
"code":"P",
"text":"Preliminary. All indexes are subject to revision four months after original publication."
}
],
"calculations":
{
"net_changes":{},
"pct_changes":
{
"1":"0.0",
"3":"0.1",
"6":"0.0",
"12":"-0.7"
}
}
},
{
"year":"2014",
"period":"M11",
"periodName":"November",
"value":"98.9",
"footnotes":
[
{
"code":"P",
"text":"Preliminary. All indexes are subject to revision four months after original publication."
}
],
"calculations":
{
"net_changes":{},
"pct_changes":
{
"1":"0.1",
"3":"-0.4",
"6":"0.0",
"12":"-0.7"
}
}
},...
You will notice that there is a part now that says calculations, and seperates values by net changes, and percent changes. I am trying to get the percent changes within the "1", "3", "6" and "12" data items.
Here is the current code I'm that does NOT find calculations but captures all the other data:
response = http.responseText
jsonSource = response
I = 0
Dim jsonData As Scripting.Dictionary
Set jsonData = JSON.parse(jsonSource)
Dim responseTime As String
responseTime = jsonData("responseTime")
Dim results As Scripting.Dictionary
On Error Resume Next
Set results = jsonData("Results")
Dim series As Collection
On Error Resume Next
Set series = results("series")
Dim seriesItem As Scripting.Dictionary
For Each seriesItem In series
Dim seriesId As String
seriesId = seriesItem("seriesID")
Dim Data As Collection
Set Data = seriesItem("data")
Dim dataItem As Scripting.Dictionary
For Each dataItem In Data
Dim Year As String
Year = dataItem("year")
I = 1 + I
Dim Period As String
Period = dataItem("period")
Dim periodName As String
periodName = dataItem("periodName")
Dim Value As String
Value = dataItem("value")
Dim footnotes As Collection
Set footnotes = dataItem("footnotes")
Dim footnotesItem As Scripting.Dictionary
For Each footnotesItem In footnotes
Dim Code As String
Code = footnotesItem("code")
Dim text As String
text = footnotesItem("text")
Next footnotesItem
Next dataItem
Next seriesItem

Answer 1

Pretty straight forward. Remember, the JSON module implements JavaScript arrays as collections and objects as Scripting.Dictionary instances.
In your context, [..].calculations, [..].calculations.net_changes and [..].calculations.pct_changes are all objects so they are all converted to Dictionary objects.
So in your code, after the For Each footnotesItem In footnotes: [..]: Next footnotesItem block (therefore, above & before the Next dataItem line), you could add the following lines:
Dim calculations As Scripting.Dictionary
Dim sIndent As String
Dim calcNetChanges As Scripting.Dictionary
Dim calcPctChanges As Scripting.Dictionary
Dim varItem As Variant
Set calculations = dataItem("calculations")
sIndent = String(4, " ")
Set calcNetChanges = calculations("net_changes")
Debug.Print Year & ", " & Period & " (" & periodName & ") - Net Changes:"
If calcNetChanges.Count > 0 Then
For Each varItem In calcNetChanges.keys
Debug.Print sIndent & CStr(varItem) & ": " & calcNetChanges.Item(varItem)
Next varItem
Else
Debug.Print sIndent & "(none)"
End If
Set calcPctChanges = calculations("pct_changes")
Debug.Print Year & ", " & Period & " (" & periodName & ") - Pct Changes:"
If calcPctChanges.Count > 0 Then
For Each varItem In calcPctChanges.keys
Debug.Print sIndent & CStr(varItem) & ": " & calcPctChanges.Item(varItem)
Next varItem
Else
Debug.Print sIndent & "(none)"
End If
which, with the json data provided, should output something like this:
2014, M12 (December) - Net Changes:
(none)
2014, M12 (December) - Pct Changes:
1: 0.0
3: 0.1
6: 0.0
12: -0.7
2014, M11 (November) - Net Changes:
(none)
2014, M11 (November) - Pct Changes:
1: 0.1
3: -0.4
6: 0.0
12: -0.7
If you want to access the items of calculations.net_changes and calculations.pct_changes directly by their keys (known in advance), you would replace the two For Each varItem blocks by, respectively:
If calcNetChanges.Exists("1") Then Debug.Print "1: " & calcNetChanges.Item("1")
If calcNetChanges.Exists("3") Then Debug.Print "3: " & calcNetChanges.Item("3")
If calcNetChanges.Exists("6") Then Debug.Print "6: " & calcNetChanges.Item("6")
If calcNetChanges.Exists("12") Then Debug.Print "12: " & calcNetChanges.Item("12")
[..]
If calcPctChanges.Exists("1") Then Debug.Print "1: " & calcPctChanges.Item("1")
If calcPctChanges.Exists("3") Then Debug.Print "3: " & calcPctChanges.Item("3")
If calcPctChanges.Exists("6") Then Debug.Print "6: " & calcPctChanges.Item("6")
If calcPctChanges.Exists("12") Then Debug.Print "12: " & calcPctChanges.Item("12")
Finally, you should note that in the json data you're giving as the example, percentages (i.e. values of items for [..].calculations.net_changes & [..].calculations.pct_changes) are provided as strings, therefore you would probably want to convert those in Double (or Single) data using Val() to perform math or other numerical operations on them, e.g.:
Dim pctChange_1 As Double, pctChange_3 As Double
Dim pctChange_6 As Double, pctChange_12 As Double
pctChange_1 = 0#
pctChange_3 = 0#
pctChange_6 = 0#
pctChange_12 = 0#
If calcPctChanges.Exists("1") Then pctChange_1 = CDbl(Val(calcPctChanges.Item("1")))
If calcPctChanges.Exists("3") Then pctChange_3 = CDbl(Val(calcPctChanges.Item("3")))
If calcPctChanges.Exists("6") Then pctChange_6 = CDbl(Val(calcPctChanges.Item("6")))
If calcPctChanges.Exists("12") Then pctChange_12 = CDbl(Val(calcPctChanges.Item("12")))

Answer 2

Declare calculations as a Scripting.Dictionary and its pct-changes as Scripting.Dictionary as well. Append the following code snippet after the code for footnotes. HTH
Dim calculations As Scripting.Dictionary
Set calculations = dataItem("calculations")
Dim pct_changes As Scripting.Dictionary
Set pct_changes = calculations("pct_changes")
Dim pct_change As Variant
For Each pct_change In pct_changes
Debug.Print pct_change & ":" & pct_changes(pct_change)
Next pct_change
The Debug.Print pct_change & ":" & pct_changes(pct_change) produces the following result for the first calculations set:
1:0.0
3:0.1
6:0.0
12:-0.7