如何在Excel for Mac 2011 VBA中将4D数据库REST查询结果存入数组

运行环境为Late 2014款Mac mini（OS 10.13.6）、Excel for Mac 2011，需定期从4D数据库通过REST接口拉取数据。此前用QueryTable处理少量数据正常，但现在每次宏需执行1500-2000次查询，每次结果单独写入表格，单次耗时超5分钟（每日多次运行）。

已验证：网络/数据库服务器并非瓶颈（M1 Mac上仅需1.5分钟）；一次性写入2000行数组比分次写入快至少25倍。但QueryTable仅支持将结果写入指定单元格区域，无法直接存入数组。

限制条件：无法修改数据源及REST接口，不熟悉SQL或Mac版ADO，且这两种方式无法解决当前问题。

需求：寻找能从外部源获取数据并追加到数组的VBA函数，或通过VBA实现类似QueryTable的功能，将结果存入数组而非单元格。

附当前使用的拉取子程序：

Public Sub REST_FillCellsWithDataFrom4D(strStartCell As String, _
                                        strServerIPAddress As String, _
                                        strServerPort As String, _
                                        strUserName As String, _
                                        strUserPassword As String, _
                                        strCallType As String, _
                                        strTableName As String, _
                                        strFieldNamesList As String, _
                                        strSearchFieldsList As String, _
                                        strSortFieldsList As String)
                                                                
    Dim strURL As String
    
    strURL = "URL;http://" & strServerIPAddress & ":" & strServerPort & "/" & strCallType
    strURL = strURL & "/table=" & strTableName
    strURL = strURL & "&fieldnames=" & strFieldNamesList
    strURL = strURL & "&searchfields=" & strSearchFieldsList
    strURL = strURL & "&sortfields=" & strSortFieldsList

    Worksheets("TablesAndFields").Range("A99") = strURL

    With ActiveSheet.QueryTables.Add(Connection:=strURL, Destination:=Range(strStartCell))
        .PostText = "user=" & strUserName & ";password=" & strUserPassword
        .RefreshStyle = xlOverwriteCells
        .SaveData = True
        .BackgroundQuery = False
        .Refresh
        .Delete
    End With
End Sub

方法1：用VBA原生HTTP请求获取数据到数组 #

放弃QueryTable，直接通过VBA发送HTTP请求获取REST接口返回的数据（通常是JSON或CSV格式），解析后存入数组，最后一次性写入表格。这是最直接的提速方案，彻底避免多次单元格写入操作。

示例代码（JSON格式返回） #

如果4D的REST接口返回JSON数据，可尝试用ScriptControl解析（若Excel for Mac 2011不支持，可改用字符串分割解析）：

Public Sub GetRESTDataToArray(strServerIPAddress As String, _
                              strServerPort As String, _
                              strUserName As String, _
                              strUserPassword As String, _
                              strCallType As String, _
                              strTableName As String, _
                              strFieldNamesList As String, _
                              strSearchFieldsList As String, _
                              strSortFieldsList As String)
    Dim http As Object
    Dim jsonResponse As String
    Dim parsedData As Variant
    Dim resultArray As Variant
    Dim i As Integer, j As Integer
    
    ' 初始化HTTP对象
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    ' 构建请求URL
    Dim strURL As String
    strURL = "http://" & strServerIPAddress & ":" & strServerPort & "/" & strCallType
    strURL = strURL & "/table=" & strTableName
    strURL = strURL & "&fieldnames=" & strFieldNamesList
    strURL = strURL & "&searchfields=" & strSearchFieldsList
    strURL = strURL & "&sortfields=" & strSortFieldsList
    
    ' 发送POST请求
    http.Open "POST", strURL, False
    http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    http.send "user=" & strUserName & ";password=" & strUserPassword
    
    ' 获取响应文本
    jsonResponse = http.ResponseText
    
    ' 解析JSON
    Dim sc As Object
    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"
    parsedData = sc.Eval("(" & jsonResponse & ")")
    
    ' 将解析后的数据存入数组
    ReDim resultArray(1 To UBound(parsedData) + 1, 1 To UBound(parsedData(0)) + 1)
    For i = 0 To UBound(parsedData)
        For j = 0 To UBound(parsedData(i))
            resultArray(i + 1, j + 1) = parsedData(i)(j)
        Next j
    Next i
    
    ' 返回数组（可在循环中追加到全局数组，最后统一写入）
    GetRESTDataToArray = resultArray
End Sub

注意事项 #

• 若接口返回CSV格式，解析更简单：直接将响应文本按换行和逗号分割存入数组即可。
• Excel for Mac 2011的MSXML2.XMLHTTP若无法使用，可替换为Microsoft.XMLHTTP测试兼容性。

方法2：临时工作表中转，批量导入数组 #

如果不想处理HTTP请求解析，可将所有QueryTable结果先写入隐藏的临时工作表，待所有查询完成后，一次性将临时表数据导入数组再写入目标表。这种方法避免了多次向目标表写入，仍能获得显著提速效果：

Public Sub BatchQueryToTempSheet()
    Dim wsTemp As Worksheet
    Dim lastRow As Long
    Dim i As Integer
    
    ' 创建隐藏临时工作表
    Set wsTemp = ThisWorkbook.Worksheets.Add
    wsTemp.Visible = xlSheetHidden
    lastRow = 1
    
    ' 循环执行查询（替换为你的实际循环逻辑）
    For i = 1 To 2000
        ' 调用原拉取子程序，写入临时表当前行
        REST_FillCellsWithDataFrom4D wsTemp.Cells(lastRow, 1).Address, _
            "服务器IP", "端口", "用户名", "密码", _
            "调用类型", "表名", "字段列表", "查询条件", "排序字段"
        
        ' 更新下一次写入的起始行
        lastRow = wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp).Row + 1
    Next i
    
    ' 将临时表数据导入数组
    Dim dataArray As Variant
    dataArray = wsTemp.UsedRange.Value
    
    ' 一次性写入目标工作表
    ThisWorkbook.Worksheets("目标表").Range("A1").Resize(UBound(dataArray, 1), UBound(dataArray, 2)).Value = dataArray
    
    ' 删除临时表
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
End Sub

方法3：优化现有QueryTable的写入效率 #

在循环执行QueryTable时，关闭Excel的屏幕更新、自动计算等功能，能小幅减少耗时：

Public Sub OptimizeQueryTablePerformance()
    ' 关闭耗时功能
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' 执行你的2000次查询循环
    ' ... 此处放入原循环调用REST_FillCellsWithDataFrom4D的代码 ...
    
    ' 恢复默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

内容的提问来源于stack exchange，提问作者Schrocks