Dim WithEvents cnnEvent As ADODB.Connection
Dim WithEvents rstEvent As ADODB.RecordsetPrivate Sub rstEvent_FetchComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    Debug.Print "FetchComplete"
End SubPrivate Sub rstEvent_FetchProgress(ByVal Progress As Long, ByVal MaxProgress As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    Debug.Print "Progress"
End SubPrivate Sub cnnEvent_ConnectComplete(ByVal pError As ADODB.Error, ByRef adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
    '判断是否出错
    If adStatus = adStatusErrorsOccurred Then
        '出错
        MsgBox "出错"
    Else
        '成功
        Debug.Print "connect"
        '建立记录集
        rstEvent.ActiveConnection = cnnEvent
        rstEvent.CursorLocation = adUseClient
        rstEvent.CursorType = adOpenKeyset
        rstEvent.LockType = adLockBatchOptimistic
        rstEvent.CacheSize = 10
        rstEvent.Source = "select * from sysobjects"
        rstEvent.Open , , , , ADODB.adAsyncFetch
    End If
End SubPrivate Sub Form_Load()
    Set cnnEvent = New ADODB.Connection
    Set rstEvent = New ADODB.Recordset
    cnnEvent.Open "driver=sql server;server=(local);database=test;uid=sa;pwd="
End Sub