QueryTimeout Property, QueryTimeout Event Example

The following example sets up the query event handlers to deal with query timeout contingencies. Notice that the QueryTimeout event procedure displays a message box that permits the user to decide if they want to wait for an additional timeout period for the query. The ShowRows procedure simply dumps the rows returned.

Option Explicit
Dim en As rdoEnvironment
Dim cn As New rdoConnection
Dim rs As rdoResultset
Dim SQL As String
Dim col As rdoColumn
Dim er As rdoError
Public WithEvents Qd As rdoQuery

Private Sub cn_QueryTimeout( _
   ByVal Query As RDO.rdoQuery, Cancel As Boolean)
Dim ans As Integer
ans = MsgBox("Query Timed out... Press Retry to continue waiting", _
    vbRetryCancel + vbCritical, "Query Took Too Long")
If ans = vbRetry Then
    Cancel = False
Else
    Cancel = True
End If
End Sub

Private Sub RunQuery_Click()

On Error GoTo RunQueryEH

    Qd(0) = Param1
    Qd.QueryTimeout = 5
    Set rs = Qd.OpenResultset(rdOpenKeyset, _
       rdConcurReadOnly)
    
    If rs Is Nothing Then Else ShowRows
    
Exit Sub

RunQueryEH:
Debug.Print Err, Error$
    For Each er In rdoErrors
        Debug.Print er.Description, er.Number
    Next
    rdoErrors.Clear
    Resume Next
    
End Sub


Private Sub Form_Load()
Set en = rdoEngine.rdoEnvironments(0)
With cn
    .Connect = "uid=;pwd=;database=workdb;dsn=WorkDB;"
    .CursorDriver = rdUseClientBatch
    .EstablishConnection Prompt:=rdDriverNoPrompt
End With

Set Qd = cn.CreateQuery("LongQuery", "")
With Qd
    .SQL = "{call VeryLongStoredProcedure (?,?)}"
    .rdoParameters(1).Direction = rdParamOutput
    .rdoParameters(0).Type = rdTypeVARCHAR
End With

End Sub