VB and VBA Users Source Code: Returning an asynchronous client side recorset with ADO
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Returning an asynchronous client side recorset with ADO
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, December 02, 2002
Hits:
1189
Category:
Database/SQL/ADO
Article:
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 'Author : Andrew Baker 'Date : 15/01/2001 22:34 'Revisions : 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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
