Returning an asynchronous client side recorset with ADO

The following function below illustrates how you would run an ADO client side (disconnected) query asynchronously:

Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

'Purpose : Executes a disconnect ADO query asynchronously.
'Inputs : sSql The SQL to execute.
' oCon The connection to execute against.
' [lQueryTimeout] If specified is the amount of time to wait (in secs) before aborting the query
'Outputs : Returns a recordset contain the results of the query


Function RecordsetOpenAsync(sSql As String, oCon As ADODB.Connection, Optional lQueryTimeout As Long = -1) As ADODB.Recordset
Dim oRs As ADODB.Recordset, lQueryTimeoutOld As Long
On Error GoTo ErrFailed

'Create recordset
Set oRs = New Recordset

If lQueryTimeout <> -1 Then
'Store and set query timeout
lQueryTimeoutOld = oCon.CommandTimeout
oCon.CommandTimeout = lQueryTimeout
End If

'Set cursor to client
oRs.CursorLocation = adUseClient

'Open recorset
'Using the "adAsyncExecute" option means the query returns immediately. If you
'use the "adAsync" option the query will return after "Initial Fetch Size" rows have been
'returned (see oRs.Properties("Initial Fetch Size") + oRs.Properties("Background Fetch Size"))
oRs.Open sSql, oCon, adOpenStatic, adLockBatchOptimistic, adAsyncExecute

'Wait for recordset to finish fetching
Do While oRs.state <> adStateOpen
Sleep 20
DoEvents
Loop

'Disconnect recordset
If oRs.EOF = False Then
'Results are pending. Move the cursor across the results to fetch them (onto the client)
oRs.MoveLast
oRs.MoveFirst
End If
'Release reference to connection
Set oRs.ActiveConnection = Nothing

If lQueryTimeout <> -1 Then
'Restore query timeout
oCon.CommandTimeout = lQueryTimeoutOld
End If

'Return recordset
Set RecordsetOpenAsync = oRs

Exit Function

ErrFailed:
'Error occured
Debug.Print Err.Description
Debug.Assert False
Set RecordsetOpenAsync = Nothing
End Function