VBA leyendo un JSON

publicado por: Anonymous

Estoy intentando leer un Json que me devuelve un servicio web y mostrar los datos en un Excel utilizando VBA. La llamada la hago con esto:

Dim hReq As Object    
Dim strUrl As String
strUrl = "http://api.worldweatheronline.com/premium/v1/weather.ashx?key=db3927718fdf4a45ad6110811182009&q=London&format=json&num_of_days=5"

Set hReq = CreateObject("MSXML2.XMLHTTP")
    With hReq
        .Open "GET", strUrl, False
        .send
    End With

Si luego de esto pongo

MsgBox hReq.responseText

me muestra el Json sin problemas. El Json sería este (está recortado ya que es muy grande, pero para mi pregunta con esto basta):

{
"data": {
    "request": [
        {
            "type": "City",
            "query": "London, United Kingdom"
        }
    ],
    "current_condition": [
        {
            "observation_time": "01:43 PM",
            "temp_C": "21",
            "temp_F": "70",
            "weatherCode": "116",
            "weatherIconUrl": [
                {
                    "value": "http://cdn.worldweatheronline.net/images/wsymbols01_png_64/wsymbol_0002_sunny_intervals.png"
                }
            ],
            "weatherDesc": [
                {
                    "value": "Partly cloudy"
                }
            ],
            "windspeedMiles": "21",
            "windspeedKmph": "33",
            "winddirDegree": "220",
            "winddir16Point": "SW",
            "precipMM": "0.1",
            "humidity": "60",
            "visibility": "10",
            "pressure": "1010",
            "cloudcover": "75",
            "FeelsLikeC": "21",
            "FeelsLikeF": "70"
        }
    ]
}
}

Si en mi código VBA pongo a continuación

Dim JSON As Object
Set JSON = JsonConverter.ParseJson(hReq.responseText)
For Each item In JSON("data")
    MsgBox item
Next item

Me va mostrando ventanas con los valores “request” y “current_condition”. Pero a mi lo que me interesaría es, por ejemplo, escribir en la celda (1,1) el valor que aparece en “value” que está dentro de “weatherDesc” y a su vez dentro de “current_condition” (lo que quiero que aparezca en la celda es “Partly cloudy”). Lo estoy intentando con el siguiente código:

Dim ws As Worksheet
Set ws = Worksheets("Hoja1")
ws.Cells(1, 1) = JSON("data")("current_condition")(0)("weatherDesc")(0)("value")

Pero me sale un error: Se ha producido el error ‘9’ en tiempo de ejecución: subíndice fuera de intervalo

Por favor alguien me podría decir como hago para escribir dicho dato? Gracias.

solución

No necesita For Each

Option Explicit
Public Sub CurrentWeatherDescription()
    Dim hReq As Object, JSON As Object
    Dim ws As Worksheet: Set ws = ActiveSheet
    Const URL As String = "http://api.worldweatheronline.com/premium/v1/weather.ashx?key=db3927718fdf4a45ad6110811182009&q=London&format=json&num_of_days=5"

    Set hReq = CreateObject("MSXML2.XMLHTTP")
    With hReq
        .Open "GET", URL, False
        .send
    End With

    Set JSON = JsonConverter.ParseJson(hReq.responseText)
    ws.Cells(1, 1) = JSON("data")("current_condition")(1)("weatherDesc")(1)("value")
End Sub

Ruta:

introducir la descripción de la imagen aquí

Respondido por: user94017

Leave a Reply

Your email address will not be published. Required fields are marked *