Как разобрать вывод fixer.io json в excel (для чайников)

Question

Я использую популярный API FIXER.IO в VBA, чтобы получить обменные курсы в некоторых ячейках моего рабочего листа с именами USD, CNY, INR и т. Д. API Fixer.io возвращал текстовый формат с указанием необходимых мне курсов. С 6 марта 2018 года устаревший API Fixer (api.fixer.io) устарел и был заменен на новую версию, для которой требуется ключ доступа API (полученный при регистрации), но возвращаемый только файл JSON. Если я позвоню по URL:

http://data.fixer.io/api/latest?access_key=XXXXXXXXXXXX&symbols=USD,CNY,INR,THB,SGD,AUD

Я получаю этот JSON взамен:

{"success":true,"timestamp":1523343843,"base":"EUR","date":"2018-04-10","rates":{"USD":1.231986,"CNY":7.757563,"INR":79.980529,"THB":38.462602,"SGD":1.614924,"AUD":1.592345}}

Как я могу проанализировать обменные значения в моих переменных Excel (USD, CNY ...)? Я пытался осмотреться, но мои очень ограниченные навыки программирования не помогли мне найти какое-либо решение. Пожалуйста, дайте ответ "для фиктивного":) Спасибо за любую помощь, оказанную С уважением Марко

Answer 1

Посмотрите на приведенный ниже пример. Импортируйте модуль JSON.bas в проект VBA для обработки JSON.

Option Explicit

Sub Test()

    Dim sJSONString As String
    Dim vJSON
    Dim sState As String
    Dim aData()
    Dim aHeader()

    ' Retrieve data
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://data.fixer.io/api/latest?access_key=209f86f5304e0043a0879d8cb45c9c10&symbols=USD,CNY,INR,THB,SGD,AUD", False
        .Send
        sJSONString = .ResponseText
    End With
    ' Parse JSON response
    JSON.Parse sJSONString, vJSON, sState
    ' Refer to target dictionary containing rates
    Set vJSON = vJSON("rates")
    ' Access to each item in dictionary
    Debug.Print vJSON("USD")
    Debug.Print vJSON("CNY")
    Debug.Print vJSON("INR")
    Debug.Print vJSON("THB")
    Debug.Print vJSON("SGD")
    Debug.Print vJSON("AUD")
    ' Convert to array and output to worksheet
    JSON.ToArray vJSON, aData, aHeader
    With Sheets(1)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With

End Sub

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Вывод для меня следующий:

Кстати, аналогичный подход применяется в следующих ответах: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 и 16.