How to run a SQL Server stored procedure asynchronously from Microsoft Access

In order to run a stored procedure asynchronously and capture the moment when the procedure terminates, I am using a class module combined with ADO.  The particular stored procedure in this example 'sp_DPSJA' collates data from other databases hence the slow execution.  It has only one argument, @bom which is the first day of a particular month for which the data is being collated.

The class module is called clsJSA and is as follows:

Option Compare Database
Option Explicit

'ADODB connection object, note withevents so we can capture the completion
Private WithEvents mcn As ADODB.Connection

'Execution flag
Dim mblnExecuted As Boolean

Private Sub Class_Initialize()
Set mcn = New ADODB.Connection
'GetADOCS just compiles a standard SQL ADO connection string in the form
'Provider=sqloledb;Data Source=<server>;Initial Catalog=<database>;User Id=<user ID>;Password=<password>
mcn.ConnectionString = GetADOCS()
mcn.Open
End Sub

Private Sub mcn_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
Dim strMsg As String

mblnExecuted = True

End Sub

Function AggregateJF(datFOM As Date) As Boolean

Dim strCMD As String
Dim rst As ADODB.Recordset
Dim cmd As ADODB.Command
Dim prm As ADODB.Parameter

On Error GoTo proc_err


Set cmd = New ADODB.Command
Set cmd.ActiveConnection = mcn

'Set up the command
cmd.CommandTimeout = 0
cmd.CommandText = "sp_DPSJA"
cmd.CommandType = adCmdStoredProc

'apply the date
Set prm = cmd.CreateParameter("@bom", adDate, adParamInput, , Format(datFOM, "dd/mmm/yyyy")): cmd.Parameters.Append prm

'run teh procedure asychronously
cmd.Execute Options:=adExecuteNoRecords + adAsyncExecute



proc_exit_true:
AggregateJF = True

proc_exit:

Exit Function

proc_exit_false:
AggregateJF = False
GoTo proc_exit

'error handler code
proc_err:
Select Case ErrHand()
Case ErrAbort
    Resume proc_exit_false
Case ErrRetry
    Resume
Case ErrIgnore
    Resume Next
End Select

End Function

Property Get Executed() As Boolean
'retrieve execution flag
Executed = mblnExecuted
End Property

Note that with ADO only the Connection object allows events, Command and other subordinate objects do not (afaik).

Now the form: when the form is loaded it checks the OpenArgs parameter (which should be the first day of a particular month) and kicks off the stored procedure using clsJSA then sets the timer interval so a message can be flashed.

Option Compare Database
Option Explicit

Dim jsa As clsJSA



Private Sub Form_Load()

Dim datFOM As Date

'The calling procedure passes the date via openargs
If Not IsBlank(Me.OpenArgs) Then
    
    'Capture the date
    datFOM = CDate(Me.OpenArgs)
    
    'Set the caption showing the month and year
    Me.lblMY.Caption = "For " & Format(datFOM, "mmmm yyyy")
    
    'Instantiate the class
    Set jsa = New clsJSA
    
    'tell the class to execute the SP
    jsa.AggregateJF datFOM
    
    'Set the timer interval for the form (two seconds) and start the hourglass
    Me.TimerInterval = 2000
    HGON
    
End If
End Sub

Private Sub Form_Timer()

'If the SP has finished the switch off the hourglass and close the form
If jsa.Executed Then
    HGOFF
    DoCmd.Close acForm, Me.Name
Else
'Otherwise flash the message
    If Me.lblPW.Visible = True Then
        Me.lblPW.Visible = False
    Else
        Me.lblPW.Visible = True
    End If
    Me.Repaint
End If

End Sub

I should perhaps point out that some of the functions here e.g. Isblank, HGON, HGOFF are my own but I think it's pretty obvious what they do :)