Creating a Loop for API Pagination in VBA

180 views Asked by At

I'm working on a VBA script to interact with the Clockify API in Excel. Within the detailedFilter key, I've noticed that static values are being used for the page parameter, limiting the API response to the latest 1000 records.

To address this limitation, I'd like to create a loop that iteratively calls the API, adjusting the page parameter based on the total number of records (entriesCount) within a given date range. For instance, if entriesCount is 3250, I need to make API calls with page values 1, 2, and 3.

The API response contains a field called entriesCount that I can use to calculate the total number of records.

Here's a snippet of the current code:

Public Sub Get2223()
    
    Set httpCaller = New MSXML2.XMLHTTP60
    
    body = "{""dateRangeStart"": ""2022-06-01T00:00:00.000"", " & vbLf & _
           " ""dateRangeEnd"": ""2023-05-30T23:59:59.000"", " & vbLf & _
           " ""detailedFilter"": {""page"": 1,""pageSize"": 1000}} "
    
    httpCaller.Open "POST", "https://reports.api.clockify.me/v1/workspaces/KEY/reports/detailed"
    httpCaller.setRequestHeader "X-Api-Key", "API_KEY"
    httpCaller.setRequestHeader "Content-Type", "application/json"
    httpCaller.send body
    
    Dim json        As Object, t As Object
    Dim Data, i     As Long, N As Long
    Data = httpCaller.responseText
    
    Set json = JsonConverter.ParseJson(Data)
    N = json("timeentries").Count
    If N < 1 Then
        MsgBox "No timeentries in JSON", vbCritical
        Exit Sub
    End If
    
    Dim dataArray() As Variant
    ReDim dataArray(1 To N, 1 To 6)
    
    i = 1
    For Each t In json("timeentries")
        dataArray(i, 1) = t("projectName")
        If Not IsNull(t("taskName")) Then
            dataArray(i, 2) = t("taskName")
        End If
        dataArray(i, 3) = t("description")
        dataArray(i, 4) = t("clientName")
        dataArray(i, 5) = t("timeInterval")("start")
        dataArray(i, 6) = t("timeInterval")("duration")
        i = i + 1
    Next
    Dim ws          As Worksheet
    Set ws = Sheets("Year2022")
    
    Dim col: col = Array(1, 5, 9, 10, 11, 7)
    For i = 0 To UBound(col)
        ws.Cells(2, col(i)).Resize(N) = WorksheetFunction.Index(dataArray, 0, i + 1)
    Next
    
End Sub

Could someone please help me with creating a loop to handle pagination in this scenario? I appreciate any guidance or suggestions.

I have tried multiple approaches but no success

 Dim httpCaller As MSXML2.XMLHTTP60, body As String
Set httpCaller = New MSXML2.XMLHTTP60
    
    ' Set your date range and initial page size
    Dim startDate As String
    Dim endDate As String
    Dim pageSize As Long

    startDate = "2022-06-01T00:00:00.000"
    endDate = "2023-05-30T23:59:59.000"
    pageSize = 1000

    body = "{""dateRangeStart"": """ & startDate & """, " & vbLf & _
           """dateRangeEnd"": """ & endDate & """, " & vbLf & _
           """detailedFilter"": {""page"": 1, ""pageSize"": " & pageSize & "}} "

    ' Parse JSON response
    Dim json As Object
    Dim Data
    Data = ""

    httpCaller.Open "POST", "https://reports.api.clockify.me/v1/workspaces/KEY/reports/detailed"
    httpCaller.setRequestHeader "X-Api-Key", "API_KEY"
    httpCaller.setRequestHeader "Content-Type", "application/json"

    ' Send the request
    httpCaller.send body

    ' Wait for the response to complete
    Do While httpCaller.readyState <> 4
        DoEvents
    Loop


    If httpCaller.Status = 200 Then

        Data = httpCaller.responseText
 
        Set json = JsonConverter.ParseJson(Data)

        Dim totalPages As Long
        totalPages = Application.WorksheetFunction.Ceiling(json("totals")("entriesCount") / pageSize, 1)

        ' Loop through additional pages
        Dim currentPage As Long
        For currentPage = 2 To totalPages
            ' Adjust the API call with the current page value
            body = Replace(body, """page"": 1", """page"": " & currentPage)

            httpCaller.send body
            Do While httpCaller.readyState <> 4
                DoEvents
            Loop

            If httpCaller.Status = 200 Then
        
                Data = httpCaller.responseText
              
                Set json = JsonConverter.ParseJson(Data)

            Else
                MsgBox "Error: " & httpCaller.Status & " - " & httpCaller.statusText, vbCritical
                Exit Sub
            End If
        Next currentPage
    Else
        MsgBox "Error: " & httpCaller.Status & " - " & httpCaller.statusText, vbCritical
    End If
2

There are 2 answers

8
Tim Williams On BEST ANSWER

Something like this maybe. I can't test so can't spend much time on it.

Option Explicit

Const WKSPACE_KEY As String = "keygoeshere"
Const API_KEY As String = "xxxxxxxxxxxxxxxxxxx"

Public Sub Get2223()
    Const PER_PAGE As Long = 1000
    
    Dim result As Object, dStart As String, dEnd As String, pgNum As Long, totResults As Long
    Dim entries As Object, numPages As Long
    
    dStart = "2022-06-01T00:00:00.000"
    dEnd = "2023-05-30T23:59:59.000"
    pgNum = 1
    
    Do
        Set result = ReportsDetailed(dStart, dEnd, pgNum, PER_PAGE)
        If result Is Nothing Then Exit Sub 'got no response
        
        If pgNum = 1 Then
            totResults = CLng(result("totals")("entriesCount"))
            numPages = Application.Ceiling(totResults / PER_PAGE, 1)
        End If
        
        Set entries = result("timeentries")
        'process entries
    
        pgNum = pgNum + 1
        If pgNum > numPages Then Exit Do
    Loop

End Sub

Function ReportsDetailed(dStart As String, dEnd As String, pageNum As Long, perPage As Long) As Object
    Dim httpCaller As Object, body As String
    
    Set httpCaller = New MSXML2.XMLHTTP60
    
    body = "{""dateRangeStart"": """ & dStart & """, " & vbLf & _
           " ""dateRangeEnd"": """ & dEnd & """, " & vbLf & _
           " ""detailedFilter"": {""page"": " & pageNum & ",""pageSize"": " & perPage & "}} "
    
    httpCaller.Open "POST", "https://reports.api.clockify.me/v1/workspaces/" & _
                             WKSPACE_KEY & "/reports/detailed"
    httpCaller.setRequestHeader "X-Api-Key", API_KEY
    httpCaller.setRequestHeader "Content-Type", "application/json"
    httpCaller.send body
    If httpCaller.Status = 200 Then
        Set ReportsDetailed = JsonConverter.ParseJson(httpCaller.responseText)
    Else
        MsgBox "Error in ReportsDetailed: " & httpCaller.Status & " - " & httpCaller.StatusText, vbCritical
    End If
End Function
1
artodoro On

I don't have enough reputation to leave a comment, so I'll try to answer correctly right away :)

In the first request you send options with page 1 and page size 1000.

body = "{""dateRangeStart"": ""2022-06-01T00:00:00.000"", " & vbLf & _
           " ""dateRangeEnd"": ""2023-05-30T23:59:59.000"", " & vbLf & _
           " ""detailedFilter"": {""page"": 1,""pageSize"": 1000}} "

If I understand correctly, you need to change the page number in a loop and send a new POST request each time and receive a responseText (and parse it to JSON), something like this:

' here is your code to get the number of pages
    Dim PageNumber As Long
    For PageNumber = 1 To PageNumbers
        body = "{""dateRangeStart"": ""2022-06-01T00:00:00.000"", " & vbLf & _
               " ""dateRangeEnd"": ""2023-05-30T23:59:59.000"", " & vbLf & _
               " ""detailedFilter"": {""page"": {PageNumber},""pageSize"": 1000}} "
        body = Replace(body, "{PageNumber}", PageNumber)
    
        httpCaller.Open "POST", "https://reports.api.clockify.me/v1/workspaces/KEY/reports/detailed"
        httpCaller.setRequestHeader "X-Api-Key", "API_KEY"
        httpCaller.setRequestHeader "Content-Type", "application/json"
        httpCaller.send body
    
        ' do smth...
    Next