How to: Send many requests to a web service at its pace

Send one request per row of a table to a web service that allows 300 requests per minute, keep the form usable while the requests run, write the result back to each row, and sign in again when the service answers 401.

Requires WKL Forms Object Library 1.60 or later.

• A WklTimerList task of kind wttHttp is a queue. RateLimit = 300 and RateWindow = 60000 keep it at 300 starts per minute; Retries repeats a request that got no answer.
• Requests.Add Method, Url, Body, Tag puts one request into the queue; the Tag (here the key of the row) comes back in every request event.
• SharedHeader(Name) sets a header sent with every request, for example the API key or the session header.
• Events: RequestCompleted for 2xx and 3xx, RequestFailed for every other answer (with the problem+json text in Result.Text) or for no answer, QueuePaused after 429, QueueHalted after 401, TaskCompleted when the queue is empty.
• A 429 pauses the whole queue for the time in Retry-After and sends the request again. A 401 halts it until the application calls Resume; the halted request is sent first, with the new shared headers.

A form frmImport with a WklTimerList named Timer1, a button cmdSenden and a text box txtStatus. The table tblImport has the fields ID (primary key), Name, Status (Number) and Meldung (Long Text). The address of the service and the key come from your own settings; never write a key into the code.

Option Compare Database
Option Explicit
 
Private Const ServiceUrl As String = "https://service.example.com/api/persons"
 
Private Sub Form_Load()
    Dim q As Object
    On Error GoTo ErrorHandler
 
    If Me!Timer1.Object.Tasks.Count = 0 Then
        Set q = Me!Timer1.Object.Tasks.Add("import", wttHttp)
        q.RateLimit = 300
        q.RateWindow = 60000
        q.Retries = 2
        q.RetryDelay = 1000
    End If
 
FinalHandler:
    Set q = Nothing
    Exit Sub
 
ErrorHandler:
    MsgBox Err.Description, vbExclamation
    Resume FinalHandler
End Sub
 
Private Sub cmdSenden_Click()
    Dim rs As DAO.Recordset, q As Object
    On Error GoTo ErrorHandler
 
    Set q = Me!Timer1.Object.Tasks("import")
    q.SharedHeader("X-Api-Key") = ApiKey()   ' your own function, for example from a protected setting
    Set rs = CurrentDb.OpenRecordset("SELECT ID, Name FROM tblImport WHERE Status = 0", dbOpenSnapshot)
    Do Until rs.EOF
        q.Requests.Add "POST", ServiceUrl, "{""name"":""" & Replace(rs!Name, """", "\""") & """}", rs!ID
        rs.MoveNext
    Loop
    q.Start
    Me!txtStatus = q.Requests.Waiting & " requests waiting"
 
FinalHandler:
    If Not rs Is Nothing Then rs.Close
    Set rs = Nothing
    Set q = Nothing
    Exit Sub
 
ErrorHandler:
    MsgBox Err.Description, vbExclamation
    Resume FinalHandler
End Sub
 
Private Sub Timer1_RequestCompleted(ByVal Key As String, ByVal Id As Long, ByVal Tag As Variant, ByVal Status As Long, ByVal Result As Object)
    On Error GoTo ErrorHandler
 
    CurrentDb.Execute "UPDATE tblImport SET Status = " & Status & ", Meldung = Null WHERE ID = " & Tag, dbFailOnError
 
FinalHandler:
    Exit Sub
 
ErrorHandler:
    Me!txtStatus = "Row " & Tag & ": " & Err.Description
    Resume FinalHandler
End Sub
 
Private Sub Timer1_RequestFailed(ByVal Key As String, ByVal Id As Long, ByVal Tag As Variant, ByVal Status As Long, ByVal Description As String, ByVal WillRetry As Boolean, ByVal Result As Object)
    Dim text As String
    On Error GoTo ErrorHandler
 
    If WillRetry Then GoTo FinalHandler          ' the queue sends it again
    text = Description
    If Not Result Is Nothing Then text = Result.Text   ' for example the problem+json message of a 422
    CurrentDb.Execute "UPDATE tblImport SET Status = " & Status & ", Meldung = '" & Replace(text, "'", "''") & "' WHERE ID = " & Tag, dbFailOnError
 
FinalHandler:
    Exit Sub
 
ErrorHandler:
    Me!txtStatus = "Row " & Tag & ": " & Err.Description
    Resume FinalHandler
End Sub
 
Private Sub Timer1_QueuePaused(ByVal Key As String, ByVal Reason As String, ByVal ResumeAt As Date)
    Me!txtStatus = "Paused by the service until " & Format(ResumeAt, "hh:nn:ss")
End Sub
 
Private Sub Timer1_QueueHalted(ByVal Key As String, ByVal Id As Long, ByVal Status As Long, ByVal Headers As String)
    On Error GoTo ErrorHandler
 
    ' 401: sign in again on the main thread, set the new header, go on with the halted request.
    If SignIn() Then   ' your own sign-in form; returns the new session in gSession
        Me!Timer1.Object.Tasks("import").SharedHeader("Wkl-Session") = gSession
        Me!Timer1.Object.Tasks("import").Resume
    Else
        Me!txtStatus = "Not signed in; the requests wait."
    End If
 
FinalHandler:
    Exit Sub
 
ErrorHandler:
    Me!txtStatus = Err.Description
    Resume FinalHandler
End Sub
 
Private Sub Timer1_TaskCompleted(ByVal Key As String, ByVal RunId As Long, ByVal Result As Variant)
    Me!txtStatus = Result(0) & " sent, " & Result(1) & " failed"
End Sub

• Another answer than 2xx, 3xx, 401 or 429 is never sent again, also not a 5xx: a repetition could do the work twice. Only a request without an answer is repeated, with the same Idempotency-Key.
• One queue per service. Two queues against the same service do not share their pace; put all requests to one service in one queue, for example on the shell form.
• Closing the form ends the queue: the requests not yet sent are dropped, no event arrives afterwards. Send them again from the rows still at Status = 0.
• Stop sends nothing more but lets the request on the way finish and report.
• The trace and the error texts never contain header values or bodies; the key stays in memory.

• WklTimerList overview: all rules of the queue.
• Search a list while the user types