ADO非同期コネクション access VBA

クラスモジュール AsyncClass
Option Compare Database
Option Explicit

Public Event CnResult(ByVal Result As Boolean, ByVal Err As ADODB.Error)
Public Event CnStart(ByVal str As String)

Private WithEvents cn As ADODB.Connection

Private Sub Class_Initialize()
Dim cnStr as String
cnStr="Connection_String"
Set cn = New ADODB.Connection
cn.ConnectionString = cnStr
End Sub

Private Sub Class_Terminate()
On Error Resume Next
cn.Close
Set cn = Nothing
End Sub

Private Sub cn_ConnectComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
Dim Result As Boolean
Select Case adStatus
　Case adStatusOK
　　Result = True
　Case Else
　　Result = False
End Select
RaiseEvent CnResult(Result, pError)
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)
RaiseEvent CnStart("test_Start")
End Sub

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

フォームモジュール
Option Compare Database
Option Explicit

Private WithEvents ac As AsyncClass

Private Sub Form_Load()
コマンド0_Click
End Sub

Private Sub Form_Timer()
Me.lblresult.Caption = Me.lblresult.Caption & "."
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set tra = Nothing
End Sub

Private Sub ac_CnResult(ByVal Result As Boolean, ByVal Err As ADODB.Error)
Me.TimerInterval = 0
If Result Then
　Me.lblresult.Caption = "OK"
Else
　Me.lblresult.Caption = "NG" & Err.Description
End If
End Sub

Private Sub ac_CnStart(ByVal str As String)
Me.lblresult.Caption = str
Me.TimerInterval = 1000
End Sub

Private Sub コマンド0_Click()
Me.lblresult.Caption = ""
Set ac = New AsyncClass
ac.teststart
End Sub