在VBA中实现Clockify API分页循环的技术求助

问题背景 #

调用Clockify的详细报告API时，由于detailedFilter中使用静态page参数，仅能获取最多1000条记录。需要通过分页循环，根据API返回的entriesCount计算总页数，逐页获取指定日期范围内的所有记录。

完整实现代码 #

Public Sub GetAllClockifyEntries()
    Dim httpCaller As MSXML2.XMLHTTP60
    Set httpCaller = New MSXML2.XMLHTTP60
    
    ' 配置参数
    Dim startDate As String, endDate As String
    Dim pageSize As Long, workspaceKey As String, apiKey As String
    startDate = "2022-06-01T00:00:00.000"
    endDate = "2023-05-30T23:59:59.000"
    pageSize = 1000
    workspaceKey = "YOUR_WORKSPACE_KEY" ' 替换为你的工作区Key
    apiKey = "YOUR_API_KEY" ' 替换为你的API Key
    
    ' 初始化变量
    Dim json As Object, totalEntries As Long, totalPages As Long
    Dim currentPage As Long, dataArray() As Variant, rowIndex As Long
    Dim t As Object, ws As Worksheet
    
    ' 获取第一页数据，同时拿到总记录数
    Dim body As String
    body = "{""dateRangeStart"": """ & startDate & """, " & _
           """dateRangeEnd"": """ & endDate & """, " & _
           """detailedFilter"": {""page"": 1, ""pageSize"": " & pageSize & "}}"
    
    With httpCaller
        .Open "POST", "https://reports.api.clockify.me/v1/workspaces/" & workspaceKey & "/reports/detailed"
        .setRequestHeader "X-Api-Key", apiKey
        .setRequestHeader "Content-Type", "application/json"
        .send body
        
        ' 等待响应完成
        Do While .readyState <> 4
            DoEvents
        Loop
        
        If .Status <> 200 Then
            MsgBox "请求第一页失败: " & .Status & " - " & .statusText, vbCritical
            Exit Sub
        End If
    End With
    
    ' 解析第一页JSON，获取总记录数
    Set json = JsonConverter.ParseJson(httpCaller.responseText)
    totalEntries = json("totals")("entriesCount")
    
    If totalEntries = 0 Then
        MsgBox "指定日期范围内无记录", vbInformation
        Exit Sub
    End If
    
    ' 计算总页数
    totalPages = Application.WorksheetFunction.Ceiling(totalEntries / pageSize, 1)
    
    ' 初始化数据数组，预留足够空间
    ReDim dataArray(1 To totalEntries, 1 To 6)
    rowIndex = 1
    
    ' 处理第一页数据
    For Each t In json("timeentries")
        PopulateDataArray dataArray, rowIndex, t
        rowIndex = rowIndex + 1
    Next t
    
    ' 循环获取剩余页面的数据
    For currentPage = 2 To totalPages
        ' 重新构建当前页的请求体（避免替换字符串出错）
        body = "{""dateRangeStart"": """ & startDate & """, " & _
               """dateRangeEnd"": """ & endDate & """, " & _
               """detailedFilter"": {""page"": " & currentPage & ", ""pageSize"": " & pageSize & "}}"
        
        With httpCaller
            .Open "POST", "https://reports.api.clockify.me/v1/workspaces/" & workspaceKey & "/reports/detailed"
            .setRequestHeader "X-Api-Key", apiKey
            .setRequestHeader "Content-Type", "application/json"
            .send body
            
            Do While .readyState <> 4
                DoEvents
            Loop
            
            If .Status <> 200 Then
                MsgBox "请求第" & currentPage & "页失败: " & .Status & " - " & .statusText, vbCritical
                Exit Sub
            End If
        End With
        
        ' 解析当前页JSON并追加数据到数组
        Set json = JsonConverter.ParseJson(httpCaller.responseText)
        For Each t In json("timeentries")
            PopulateDataArray dataArray, rowIndex, t
            rowIndex = rowIndex + 1
        Next t
    Next currentPage
    
    ' 将数据写入Excel工作表
    Set ws = ThisWorkbook.Sheets("Year2022")
    ' 清空原有数据（可选）
    ws.Range("A2:K" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    Dim colMapping As Variant
    colMapping = Array(1, 5, 9, 10, 11, 7) ' 对应数据数组的列到工作表的列
    For i = 0 To UBound(colMapping)
        ws.Cells(2, colMapping(i)).Resize(totalEntries) = WorksheetFunction.Index(dataArray, 0, i + 1)
    Next i
    
    MsgBox "数据获取完成，共导入" & totalEntries & "条记录", vbInformation
End Sub

' 辅助函数：将单条时间记录填充到数据数组
Private Sub PopulateDataArray(ByRef arr As Variant, rowNum As Long, entry As Object)
    arr(rowNum, 1) = entry("projectName")
    If Not entry("taskName") Is Nothing Then
        arr(rowNum, 2) = entry("taskName")
    End If
    arr(rowNum, 3) = entry("description")
    arr(rowNum, 4) = entry("clientName")
    arr(rowNum, 5) = entry("timeInterval")("start")
    arr(rowNum, 6) = entry("timeInterval")("duration")
End Sub

关键改进点 #

• 避免字符串替换错误：每次请求新页面时重新构建完整的JSON请求体，而不是用Replace修改page参数，防止因多次替换导致的字符串匹配失败。
• 动态数据收集：初始化足够大的数组，将每一页的记录依次追加进去，确保所有数据都被保留。
• 错误处理：对每一页的请求状态进行检查，遇到错误时及时提示并退出。
• 代码模块化：将记录填充逻辑抽离为辅助函数PopulateDataArray，提高代码可读性和维护性。
• 清空旧数据：写入新数据前清空工作表原有数据（可选，根据需求调整）。

使用说明 #

1. 确保已安装并引用JsonConverter模块（用于JSON解析）。
2. 替换代码中的YOUR_WORKSPACE_KEY和YOUR_API_KEY为实际值。
3. 调整startDate、endDate和工作表名称Year2022以匹配你的需求。

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