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字符串的名字命名。如何从该json字符串中设置变量firstName =“ Eve”。

Answer 1

如果您需要在VBA中使用JSON，那么我建议使用此库：

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

Answer 2

这是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

如何从另一个变量Excel VBA设置等于JSON值的变量

2 个答案: