MS- Access+ADO非同期処理 AsyncClass改

CtrEnabledChangeで引数Meを投げると、元フォーム詳細上コントロールをコレクションに格納してEnabledをFalseに設定
再び投げるとコレクション内コントロールのEnabledをTrueに再設定 

Option Compare Database
Option Explicit

Private WithEvents cn As ADODB.Connection
Private rs As ADODB.Recordset
Private CtrCollection As Collection

Public Event WillConnect()
Public Event Connected(cnStatus As ADODB.EventStatusEnum, cnError As ADODB.Error)
Public Event WillExecute()
Public Event ExecuteComplete(cnStatus As ADODB.EventStatusEnum, ResultRS As ADODB.Recordset, ResultRecordsAffected As Long, cnError As ADODB.Error)
Public Event DisConnected()

Private Sub Class_Initialize()
Debug.Print "******ClassInitialize******"
Application.Echo False
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    cn.ConnectionString = "ConnectionString"
                         
    rs.CursorLocation = adUseClient
End Sub

Private Sub Class_Terminate()
Debug.Print "******ClassTerminate******"
Application.Echo True
On Error Resume Next
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

Private Sub cn_Disconnect(adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
    Debug.Print "DisConnected:" & Now()
    RaiseEvent DisConnected
End Sub

Private Sub cn_WillConnect(ConnectionString As String, UserID As String, Password As String, Options As Long, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
    Debug.Print "WillConnect:" & Now()
    RaiseEvent WillConnect
End Sub

Private Sub cn_ConnectComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
    Debug.Print "ConnectComplete:" & Now()
    RaiseEvent Connected(adStatus, pError)
End Sub

Private Sub cn_WillExecute(Source As String, CursorType As ADODB.CursorTypeEnum, LockType As ADODB.LockTypeEnum, Options As Long, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
    Debug.Print "WillExecute:" & Now()
    RaiseEvent WillExecute
End Sub

Private Sub cn_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)
    Debug.Print "ExecuteComplete:" & Now()
    RaiseEvent ExecuteComplete(adStatus, pRecordset, RecordsAffected, pError)
End Sub

Public Sub ConnectionStart()
    cn.Open , , , adAsyncConnect
End Sub

Public Sub ExecQuery(SQLstring As String)
    rs.Open SQLstring, cn, adOpenKeyset, adLockOptimistic, adAsyncExecute
End Sub

Public Sub ExecQueryReadOnly(SQLstring As String)
    rs.Open SQLstring, cn, adOpenForwardOnly, adLockReadOnly, adAsyncExecute
End Sub

Public Sub ConnectionCancel()
    If cn.State = adStateConnecting And rs.State = adStateClosed Then
        RaiseEvent DisConnected
    ElseIf cn.State = adStateExecuting And rs.State = adStateClosed Then
        cn.Cancel
        cn.Close
    ElseIf cn.State = adStateOpen And rs.State = adStateExecuting Then
        rs.Cancel
        cn.Close
    End If
    Debug.Print "Cancel:" & Now()
End Sub

Public Sub ConnectionClose()
On Error Resume Next
    If cn.State = adStateOpen Then
        cn.Close
    End If
On Error GoTo 0
    RaiseEvent DisConnected
End Sub

Public Sub CtrEnabledChange(Frm As Form)
Dim Ctr As Control
DoCmd.RunCommand acCmdSelectRecord
    If CtrCollection Is Nothing Then
        Set CtrCollection = New Collection
        For Each Ctr In Frm.詳細.Controls
            If CtrEnabled(Ctr) Then
                If Ctr.Enabled = True Then
                    Ctr.Enabled = False
                    CtrCollection.Add Ctr
                End If
            End If
        Next
    Else
        For Each Ctr In CtrCollection
            Ctr.Enabled = True
        Next
        Set CtrCollection = Nothing
    End If
End Sub

Private Function CtrEnabled(Ctr As Control) As Boolean
On Error GoTo ErrLabel
    CtrEnabled = False
    If Ctr.Enabled = True Then CtrEnabled = True
    Exit Function
ErrLabel:
    CtrEnabled = False
End Function