Private WithEvents cnE As ADODB.Connection     'указатель на Event-handled подключение
Private WithEvents rsOrg As ADODB.Recordset    'указатель на Event-handled рекордсет
Private cmd As New ADODB.Command

    Set rsOrg = cmd.Execute(, , adCmdStoredProc + adAsyncFetch + adAsyncFetchNonBlocking + adAsyncExecute)

Private Sub cnE_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)
'The ExecuteComplete event is called after a command has finished executing.
DoEvents
If Not (pError Is Nothing) Then
    If pError.Number <> 0 Then
        Dim s As String
        s = pError.Number & Comma & pError.Description & Comma & pError.Source & vbCrLf '
        Dim sErr As Error
        For Each sErr In pConnection.Errors
            s = s & sErr.Number & Comma & sErr.Source & Comma & sErr.Description & vbCrLf
        Next sErr
        Err.Clear
'    установить свойство класса "Операция выполнена с ошибкой, к-во записей=0"         
' .............        
    End If
Else
    With pRecordset
        If .State = ObjectStateEnum.adStateClosed Then
 '    операция выполнена, удовлетворяющих запросу записей нет:
                rsOrgOK = True       'Ваши идентификаторы, естественно, другие...
                rsOrgRows =  0 : rsMaxRows =  0 
'     возбудить пользовательский обработчик события "Рекордсет получен":
                RaiseEvent RsDone(...)
        Else
'    настроить параметры пакетов для пересылки рекордсета клиенту:
                .CacheSize = .RecordCount
                rsMaxRows = .RecordCount
        End If
    End With
End If
End Sub

Private Sub rsOrg_FetchProgress(....)
'   ..............
End Sub

Private Sub rsOrg_FetchComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'  ..............
End Sub