Visual Basic Codes
Visual Basic > Database SQL Stuff sample source codes

Returning an asynchronous client side recorset with ADO

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