hi,
Sorry, I am unable to follow the link due to restrictions on my works system.
Could you paste the code?
Is it possible to mix ADO and DAO code?
Yes.
Taken from Elmar Boye:
' A class modul named clsExecute
Option Explicit
Dim WithEvents mcnnAsync As ADODB.Connection
Dim mcmdAsync As ADODB.Command
Dim mShowMsgBox As Boolean
Private Sub Class_Terminate()
If Not mcmdAsync Is Nothing Then
mcmdAsync.Cancel
End If
End Sub
Public Sub ExecuteSQLAsync(cnn As ADODB.Connection, _
strSQL As String, _
Optional ShowMsgBox As Boolean = False)
Set mcnnAsync = cnn
Set mcmdAsync = New ADODB.Command
With mcmdAsync
.CommandTimeout = 0
.CommandType = adCmdText
.CommandText = strSQL
Set .ActiveConnection = cnn
End With
mcmdAsync.Execute Options:=adAsyncExecute + adExecuteNoRecords
mShowMsgBox = ShowMsgBox
End Sub
Public Sub Cancel()
If Not mcmdAsync Is Nothing Then
If (mcmdAsync.State And adStateExecuting) = adStateExecuting Then
mcmdAsync.Cancel
End If
End If
End Sub
Public Property Get IsExecuting() As Boolean
If Not mcmdAsync Is Nothing Then
IsExecuting = (mcmdAsync.State And adStateExecuting)
Else
IsExecuting = False
End If
End Property
Private Sub mcnnAsync_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 pConnection = mcnnAsync Then
If mShowMsgBox = True Then
MsgBox "Finished"
End If
End If
End Sub
' Testcode:
Dim oExecute As clsExecute
Sub ExecuteLong()
Dim cnn As ADODB.Connection
Set oExecute = New clsExecute
oExecute.ExecuteSQLAsync CurrentProject.Connection, _
"WAITFOR DELAY '00:00:15'", True
Do While oExecute.IsExecuting = True
Dim nCount As Long
nCount = nCount + 1
If nCount Mod 100 = 0 Then
Debug.Print "Waiting " & nCount
End If
If nCount Mod 10000 = 0 Then
'oExecute.Cancel
End If
Loop
End Sub
