VBA - Some copy and pastable code for retrying an asynchronous operation

Some operations are asynchronous, a line of VBA code may say close window but the OS responds in its own time, the next line of code that relied upon that window being closed then runs the risk of failing if run too soon. Now, we can add delays or alternatively we can implement a retry mechanism, I chose the latter.

I'm not happy with the code but nevertheless I am depositing some code here today for future use. Initially I built a class but then decided it was over-engineered and I scrapped that and replaced it with some boilerplate code to be added when an operation needs retrying. You can see the code below, note how there is one single line of code surround by fluff to make the retry mechanism work.

I'm really not happy but can't help feeling that an OS level mechanism would be helpful or a future language implementation ships a new feature.

The code is meant to sit in a class and uses two class level variables, bVerbose and bDebug. I recommend copying, pasting then customising. I do not recommend trying to write a utility class to handle many use cases.

Anyway here is the code.

Public bVerbose As Boolean
Public bDebug As Boolean

Function CreateFolderMultipleAttempts(ByVal sFolder As String)
    
    On Error GoTo ErrHandler
    
    Dim dtInterval As Date
    dtInterval = Interval(1)
    
    Const lMaxAttempts As Long = 3

    Dim lAttempts As Long
    lAttempts = 0

    Dim fso As New Scripting.FileSystemObject

Retry:
    On Error Resume Next
    
    If lAttempts < lMaxAttempts Then
        lAttempts = lAttempts + 1
        If bVerbose Then Debug.Print "Attempting (" & lAttempts & " of " & lMaxAttempts & ") to call [" & TypeName(fso) & "].CreateFolder"
        
        '**********************************************************************************************************************************
        '* CORE OPERATION
        '**********************************************************************************************************************************
        fso.CreateFolder sFolder
        '**********************************************************************************************************************************
        '* END OF CORE OPERATION
        '**********************************************************************************************************************************
        
    End If

    If Err.Number <> 0 Then
        If lAttempts < lMaxAttempts Then
            '* still have some goes left, report (of verbose) then wait
            If bVerbose Then Debug.Print "(" & Err.Number & ") " & Err.Description & " whilst attempting to call [" & TypeName(fso) & "].CreateFolder"
    
            If dtInterval > 0 Then
                If bVerbose Then Debug.Print "reattempting after interval " & VBA.FormatDateTime(dtInterval)
                Application.Wait Now() + dtInterval
            End If
            Err.Clear
    
            GoTo Retry
        Else
            '* no more attempts left, throw to caller
            On Error GoTo 0
            Err.Raise Err.Number, Err.Source, Err.Description
        End If
    End If

SingleExit:
    Exit Function
    
ErrHandler:
    If bDebug Then
        Debug.Print "step-thru: (" & Err.Number & ") " & Err.Description & " whilst attempting to create folder '" & sFolder & "'"
        Stop
        Resume
    Else
        Err.Raise Err.Number, Err.Source, Err.Description
    End If
End Function

Private Function Interval(ByVal lIntervalSeconds As Long) As Date
    
    Dim lHours As Long
    lHours = lIntervalSeconds \ 3600
    
    Dim lMinutes As Long
    lMinutes = (lIntervalSeconds Mod 3600) \ 60
    
    Dim lSeconds As Long
    lSeconds = (lIntervalSeconds Mod 3600) Mod 60
    
    Dim sInterval As String
    sInterval = Right$("00" & lHours, 2) & ":" & Right$("00" & lMinutes, 2) & ":" & Right$("00" & lSeconds, 2)


    Interval = CDate(sInterval)
End Function