access2010 ADO非同期処理 メモ Form.Open

Option Compare Database
Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private WithEvents cnCls1 As Class_ADOConnectionAsyncWithDialog

Private cnCondition As Boolean
Private OpenCancel As Boolean
Private cnErrMsg As String

Private Sub SetInit()
    Set cnCls1 = New Class_ADOConnectionAsyncWithDialog
    cnErrMsg = ""
    cnCls1.ConnectionStart
End Sub

Private Sub cnCls1_Connected(cnStatus As ADODB.EventStatusEnum, cnError As ADODB.Error)
    If cnStatus = adStatusOK Then
        cnCls1.ExecQueryReadOnly "procedurestring"
    Else
        OpenCancel = True
        cnErrMsg = "Connection Error:" & cnError.Description
        cnCls1.ConnectionClose'cnErrMsg代入を先にしないとConnectionCloseが先に実行される場合がある
    End If
End Sub

Private Sub cnCls1_ExecuteComplete(cnStatus As ADODB.EventStatusEnum, ResultRS As ADODB.Recordset, ResultRecordsAffected As Long, cnError As ADODB.Error)
    If cnStatus = adStatusOK Then
        'ここでいろいろセッティング
    Else
        OpenCancel = True
        cnErrMsg = "Execute Error:" & cnError.Description
    End If
    cnCls1.ConnectionClose 
End Sub

Private Sub cnCls1_DisConnected()
    Set cnCls1 = Nothing
    cnCondition = True
End Sub

Private Sub Form_Open(Cancel As Integer)
On Error GoTo Errhnd
    cnCondition = False
    OpenCancel = False
    SetInit
    While cnCondition = False'ここでLoopさせて待機
        DoEvents
        Sleep 100
    Wend
    If Not cnErrMsg = "" Then MsgBox cnErrMsg
    Cancel = OpenCancel
Exit Sub
Errhnd:
    Cancel = True
End Sub

Private Sub Form_Close()
On Error Resume Next
    Set cnCls1 = Nothing
End Sub