クラスモジュール 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
0 件のコメント:
コメントを投稿