json - 从大数据库中将数据从 api 提取到 excel

Question

我使用一个API来提取数据Excel并JSON解析以格式化数据。我有 2 个站点可以从中获取这些数据。1 是较小的数据库，有 3000 行，但另一个更大，有数十万行。使用较小的我没有错误，一切正常，但在更大的数据库上使用相同的代码，一切都会出现崩溃/永远挂起。我使用的代码肯定是非常错误的，有人告诉我我使用了太多的解析，但我是新手，所以现在无法真正弄清楚。

我正在使用的代码：

Option Explicit

Sub Times()

    Dim sJSONString As String
    Dim vJSON
    Dim sState As String
    Dim aData()
    Dim aHeader()
    Dim vResult
    Dim sName
    Dim authKey As String
    authKey = "my_auth_key"

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://my_site_url", True
        .SetRequestHeader "Authorization", "Bearer " & authKey
        .send
        Do Until .readyState = 4: DoEvents: Loop
        sJSONString = .responseText
    End With
    JSON.Parse sJSONString, vJSON, sState
    If sState = "Error" Then
        MsgBox "Invalid JSON"
        End
    End If
    vResult = vJSON("data")
    JSON.ToArray vResult, aData, aHeader
    With ThisWorkbook.Sheets(1)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With
    vJSON.Remove "data"
    Application.DisplayAlerts = False
    With ThisWorkbook.Sheets
        Do Until .Count = 1
            .Item(.Count).Delete
        Loop
    End With
    Application.DisplayAlerts = True
    For Each sName In vJSON
        If IsArray(vJSON(sName)) Or IsObject(vJSON(sName)) Then
            JSON.ToArray vJSON(sName), aData, aHeader
            With ThisWorkbook.Sheets.Add
                OutputArray .Cells(1, 1), aHeader
                Output2DArray .Cells(2, 1), aData
                .Columns.AutoFit
            End With
            vJSON.Remove sName
        End If
    Next
    JSON.ToArray vJSON, aData, aHeader

    JSON.Parse sJSONString, vJSON, sState
    JSON.Flatten vJSON, vResult
    JSON.ToArray vResult, aData, aHeader

    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

也许通过简化和更正代码，我更大的数据库宏也可以工作。

标签： jsonexcelvba