What is the proper way to add retry loop to VBA code

Question

In the following code, we occasionally get collision errors. If it would wait a second and retry, it would go through.

I want it to try once. If it fails, log the error and retry. If it fails 3 times, MsgBox to the user, give up and return. The only way I can think of is using a GOTO back to the ExeHandler. Seems there should be a better way.

  Public Function RunADO(strContext As String, strSQL As String, Optional intErrSilent As Integer = 0, Optional intErrLog = -1) As Integer
  On Error GoTo ErrHandler
  ExeHandler:

     PostToLog strContext, "SQL: " & strSQL
     CurrentProject.Connection.Execute strSQL, dbFailOnError
     RunADO = -1
     Exit Function
  ErrHandler:
     RunADO = 0
     If intErrSilent = 0 Then
        MsgBox Err.Number & ": " & Err.Description, vbCritical, "Run ADO"
     End If
     If intErrLog = -1 Then
        PostErrorToLog Err.Number, strContext, Err.Source & ":" & Err.Description & ": " & "SQL: " & strSQL
     End If
  End Function

score 1 · Accepted Answer · answered Apr 17 '21 at 00:25

Perhaps something like this...

    Option Explicit

    Private Const MaxRetries As Long = 3

    Public Function RunADO(strContext As String, strSQL As String, Optional intErrSilent As Integer = 0, Optional intErrLog = -1) As Integer
        Dim attemptCounter As Long
        For attemptCounter = 1 To MaxRetries
            RunADO = RunADOInternal(strContext, strSQL, intErrSilent, intErrLog)
            If RunADO = -1 Then
                Exit Function
            End If
            If intErrSilent = 0 And attemptCounter >= MaxRetries Then
                MsgBox Err.Number & ": " & Err.Description, vbCritical, "Run ADO"
                RunADO = 0
                Exit Function
            End If
            If intErrLog = -1 Then
                PostErrorToLog Err.Number, strContext, Err.Source & ":" & Err.Description & ": " & "SQL: " & strSQL
            End If
            Application.Wait (Now + TimeValue("0:00:01"))
        Next attemptCounter
    End Function

    Private Function RunADOInternal(strContext As String, strSQL As String, Optional intErrSilent As Integer = 0, Optional intErrLog = -1) As Integer
      On Error GoTo ErrHandler

         PostToLog strContext, "SQL: " & strSQL
         CurrentProject.Connection.Execute strSQL, dbFailOnError
         RunADO = -1
         Exit Function
    ErrHandler:
         RunADO = 0
    End Function

These are both excellent answers. I like this one a bit better as I think it is clearer and easier to read. Separating the execution into it's own function allows you to use the built in error handling and still wrap logic around it. — BWhite, Apr 18 '21 at 03:53

score 1 · Answer 2 · answered Apr 17 '21 at 01:03

Consider using a Do / Loop statement that ends when the maximum number of attempts have been made.

Public Function RunADO(strContext As String, _
                       strSQL As String, _
                       Optional intErrSilent As Integer, _
                       Optional intErrLog = -1) As Integer
  
    Dim Attempts As Integer
    
    Do While Attempts < 3
        On Error Resume Next
        PostToLog strContext, "SQL: " & strSQL
        CurrentProject.Connection.Execute strSQL, dbFailOnError
        If Err.Number Then
            If intErrSilent = 0 Then
               MsgBox Err.Number & ": " & Err.Description, vbCritical, "Run ADO"
            End If
            If intErrLog = -1 Then
               PostErrorToLog Err.Number, strContext, _
                              Err.Source & ":" & Err.Description & ": " & "SQL: " & strSQL
            End If
            Attempts = Attempts + 1
        Else
            RunADO = -1
            Exit Do
        End If
     Loop
  End Function

What is the proper way to add retry loop to VBA code

2 Answers2