VBA-JSON Nested Collection Parse into Excel

Question

I am using the VBA-JSON module from link below, the source from where the weather information is capctured from has changed from a list strcture for 7 day's data being hourly listed, into an array for the day, and each day has another arrary for the hour.

This is the module I have imported into VBA as a Marco. https://github.com/VBA-tools/VBA-JSON

forecastday and hour is an collection object when converted using this VBA-JSON library, I am not familiar with VBA....how should I correct the two lines within the for loop to have data displayed like the image attached ? (This was how the system worked before the http source changed)

http://api.weatherapi.com/v1/forecast.json?key=4c6f7219367f4aa5b0c174927231104&q=51.180224,-113.9385224&days=7&aqi=no&alerts=no

Public Sub exceljson()

Dim http As Object, JSON As Object, i As Integer

Set http = CreateObject("MSXML2.XMLHTTP")

http.Open "GET", "http://api.weatherapi.com/v1/forecast.json?key=4c6f7219367f4aa5b0c174927231104&q=51.180224,-113.9385224&days=7&aqi=no&alerts=no", False
http.Send

Set JSON = JsonConverter.ParseJson(http.responseText)

For i = 4 To 169

Sheets("Setup").Cells(i, 1).Value = JSON("forecast")("forecastday")("hour")(i)("time_epoch")
Sheets("Setup").Cells(i, 2).Value = JSON("forecast")("forecastday")("hour")(i)("temp_c")

Next

End Sub

(expected excel results)

The following two lines in the loop is where it generates an error when executed.

For i = 4 To 169

Sheets("Setup").Cells(i, 1).Value = JSON("forecast")("forecastday")("hour")(i)("time_epoch")
Sheets("Setup").Cells(i, 2).Value = JSON("forecast")("forecastday")("hour")(i)("temp_c")

Next.

But I am unsure how to handle nested collection objects. Should there be an (j) and (i) ? j for < 8 for number of days in a week? I read that JSON converter for VBA converts any [] values into a VBA collecton object.

Whatever I tried either give runtime error 5 or 13.

Should this be the expected format? But it's not accepted when debugged. I believe forecastday should be looped 7 times for the days in a week, and then for each day there should be a hourly loop for the 24 hours in a day? Not sure how to acheive that in VBA.

JSON("forecast")("forecastday")(j)("hour")(i)("temp_c")

Please help,how can I do this? I have attached expected results in an image called "(expected excel results)" for a tab called "setup" there's colume A starting at row 4 recording epooch timestamp entries, column B is the forecasted temperature for that day, predicated hourly.

Answer 1

Since forecastday is actually a collection and not dictionary, you need to loop through the 7 days and then the 24 hours. Therefore, consider a nested loop with row and column iterators. Below returns all elements of hour except for nested condition.

Public Sub exceljson()
On Error GoTo ErrHandle
    Dim http As Object, JSON As Object
    Dim currHour As Dictionary
    Dim k As Variant
    Dim i As Long, j As Long, row As Long, col As Long

    Set http = CreateObject("MSXML2.XMLHTTP")
    
    http.Open "GET", "http://api.weatherapi.com/v1/forecast.json?key=4c6f7219367f4aa5b0c174927231104&q=51.180224,-113.9385224&days=7&aqi=no&alerts=no", False
    http.Send
    
    Set JSON = JsonConverter.ParseJson(http.responseText)

    row = 2
    For i = 1 To JSON("forecast")("forecastday").Count
        For j = 1 To JSON("forecast")("forecastday")(i)("hour").Count
            Set currHour = JSON("forecast")("forecastday")(i)("hour")(j)
            col = 1
            For Each k In currHour.Keys
                If row = 2 Then
                    Sheets("Setup").Cells(1, col) = k               ' HEADER
                End If
                If k <> "condition" Then
                    Sheets("Setup").Cells(row, col) = currHour(k)   ' DATA
                    col = col + 1
                End If
            Next k
            row = row + 1
        Next j
    Next i
    
ExitHandle:
    Set currHour = Nothing: Set JSON = Nothing: Set http = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & ": " & Err.Description, vbCritical, "RUNTIME ERROR"
    Resume ExitHandle
End Sub

Output