PRB: QueryTimeout Event Not AvailableID: Q190606
|
The ActiveX Data Objects (ADO) Connection object does not expose a QueryTimeout event as does the rdoConnection object, which allows programmatic control over whether to continue waiting for query results.
This is a design limitation.
Execute the query asynchronously. You can use a Timer event to call code that determines whether to cancel the query.
This behavior is a limitation of the ADO object model for the versions listed at the beginning of this article.
The Remote Data Objects (RDO) 2.0 rdoConnection objects expose a
QueryTimeout event. For long-running queries, this event fires after
QueryTimeout seconds and allows you to cancel the query or to continue for
another QueryTimeout seconds, when the event fires again.
ADO does not expose a QueryTimeout event. This article lists some
techniques to get similar functionality.
If adStatus = adStatusErrorsOccurred Then
If pError.Number = -2147217871 Then
Debug.Print "Execute timed-out"
End If
End If
Microsoft ActiveX Data Objects Library
Name: txtMessage Make this Textbox large enough to display a reasonable message Name: cmdRetry Caption: Retry Name: cmdCancel Caption: Cancel
Option Explicit
Dim fCancel As Boolean
Private Sub cmdCancel_Click ()
fCancel = True
Me.Visible = False
End Sub
Private Sub cmdRetry_Click ()
fCancel = False
Me.Visible = False
End Sub
Name: cmdDetect Caption: Detect Timeout Name: cmdChoose Caption: Time-out?
Option Explicit
Dim WithEvents cn As ADODB.Connection, rs As ADODB.Recordset
Private Sub cmdChoose_Click()
Dim SQL As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open "dsn=mydsn;database=pubs" ' *** change connect string ***
'CommandTimeout is optional; default is 30 seconds.
cn.CommandTimeout = 15
'
' This query must exceed the Timer1.Interval in order to test.
'
SQL = "SELECT authors.* FROM authors, titles a, titles b"
rs.Open SQL, cn, adOpenKeyset, adLockOptimistic, adAsyncExecute
Timer1.Interval = 2000
End Sub
Private Sub cn_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)
If adStatus = adStatusErrorsOccurred Then
If pError.Number = -2147217871 Then
Debug.Print "Execute timed-out"
End If
End If
Timer1.Interval = 0 ' turn off timer for async code
if adStatus = adStatusOK Then
If pRecordset.State = adStateOpen Then
'
' Execute code now async query has completed.
'
Debug.Print "Query Complete."
End If
End If
End Sub
Private Sub cmdDetect_Click()
Dim SQL As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open "dsn=mydsn;database=pubs" ' *** change connect string ***
'The below is set low for demonstration purposes, it is optional.
cn.CommandTimeout = 2
SQL = "SELECT authors.* FROM authors, titles a, titles b"
rs.Open SQL, cn, adOpenKeyset, adLockOptimistic, adAsyncExecute
End Sub
Private Sub Timer1_Timer()
Select Case rs.State
Case adStateConnecting, adStateExecuting, adStateFetching
If SafeMsgBox("Query has timed-out.") = vbCancel Then
rs.Cancel
Timer1.Interval = 0
End If
Case Else
Timer1.Interval = 0 ' catch-all
End Select
End Sub
Private Function SafeMsgBox(ByVal Message As String) As Long
Load Form2
Form2.txtMessage = Message
Form2.Show vbModal
SafeMsgBox = IIf(Form2.fCancel, vbCancel, vbRetry)
Unload Form2
End Function
OLE DB 2.0 SDK; search on: "CommandTimeout Property"; "ADO Events"
Additional query words: kbprb kbDatabase kbADO150 kbADO200 kbVBp kbSweepNext
Keywords : kbADO150 kbADO200 kbDatabase kbVBp kbprb kbSweepNext
Version : WINDOWS:1.0,1.5,2.0
Platform : WINDOWS
Issue type : kbprb
Last Reviewed: June 30, 1999