Как установить переменную, равную значению json из другой переменной excel vba

Question

json, который я анализирую, находится по этому URL https://reqres.in/api/users?page=2. Я использую следующий код для его анализа.

Option Explicit

Sub Test_LateBinding()

Dim objRequest As Object
Dim strUrl As String
Dim blnAsync As Boolean
Dim strResponse As String

Set objRequest = CreateObject("MSXML2.XMLHTTP")
strUrl = "https://reqres.in/api/users?page=2"
blnAsync = True

With objRequest
    .Open "GET", strUrl, blnAsync
    .SetRequestHeader "Content-Type", "application/json"
    .Send
    'spin wheels whilst waiting for response
    While objRequest.readyState <> 4
        DoEvents
    Wend
    strResponse = .ResponseText
End With

Debug.Print strResponse

End Sub

Я могу успешно получить json в переменную strResponse.Но допустим, я хочу переменную, равную «Eve», которая находится под именем в строке json.Как я могу установить переменную firstName = "Eve" из этой строки JSON.

Answer 1

Вот пример VBA, показывающий, как эти значения могут быть получены. Импорт JSON.bas модуля в проект VBA для обработки JSON.

Option Explicit

Sub Test()

    Dim sJSONString As String
    Dim vJSON
    Dim sState As String
    Dim aItems
    Dim firstName As String
    Dim oItem
    Dim i As Long
    Dim aData()
    Dim aHeader()

    ' Retrieve JSON content
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://reqres.in/api/users?page=2", True
        .send
        Do Until .readyState = 4: DoEvents: Loop
        sJSONString = .responseText
    End With
    ' Parse JSON sample
    JSON.Parse sJSONString, vJSON, sState
    If sState = "Error" Then
        MsgBox "Invalid JSON"
        End
    End If
    ' Process objects in array
    ' Get 'data' array of objects, there is no Set keyword for arrays
    aItems = vJSON("data")
    ' Access specific item 'first_name' property
    firstName = aItems(0)("first_name")
    Debug.Print firstName
    ' Access each item 'first_name' property
    For Each oItem In aItems
        firstName = oItem("first_name")
        Debug.Print firstName
    Next
    ' Convert array of objects to 2d array
    JSON.ToArray aItems, aData, aHeader
    ' Access each item element with index 1, which corresponds to 'first_name' property
    For i = 0 To UBound(aData, 1)
        firstName = aData(i, 1)
        Debug.Print firstName
    Next
    ' Output 2d array to first worksheet
    With ThisWorkbook.Sheets(1)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With
    MsgBox "Completed"

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

Answer 2

Если вам нужно работать с JSON в VBA, я бы порекомендовал использовать эту библиотеку:

https://github.com/VBA-tools/VBA-JSON

Простой пример использования этой библиотеки:

Public Sub Tester()

    Dim http As Object, JSON As Object, d
    Set http = CreateObject("MSXML2.XMLHTTP")

    http.Open "GET", "https://reqres.in/api/users?page=2", False
    http.SetRequestHeader "Content-Type", "application/json"
    http.Send
    Set JSON = ParseJson(http.responseText)

    For Each d In JSON("data")
        Debug.Print d("id"), d("first_name")
    Next

End Sub