ADOコネクションのヘルパークラス

hlpAdoConnect.cls

'---------------------------------------------------------------------------------------
' Module    : hlpAdoConnect
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : データベースコネクションを管理
' Note      : スタンドアロンでの使用を前提とする
'---------------------------------------------------------------------------------------
Option Explicit

'*** Instance Variable ***
Dim cn_ As ADODB.Connection
Dim dbPath_ As String
Dim connectionString_ As String
Dim transLevel_ As Long
Dim errorMessage_ As String

'*** Const ***
Const CONNECTION_STRING_ACCESS_2010 As String = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source="
Const TRANS_LEVEL_DEFAULT As Long = 0

'---------------------------------------------------------------------------------------
' Procedure : dbPath(Setter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : Accessファイルのフルパスを代入
' Param     : str Accessファイルのフルパス
'---------------------------------------------------------------------------------------
Property Let dbPath(ByVal str As String)
  dbPath_ = str
End Property

'---------------------------------------------------------------------------------------
' Procedure : dbPath(Getter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : Accessファイルのフルパスを返す
'---------------------------------------------------------------------------------------
Property Get dbPath() As String
  dbPath = dbPath_
End Property

'---------------------------------------------------------------------------------------
' Procedure : connectionString(Setter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : データベース接続文字列を代入
' Param     : str 接続文字列
'---------------------------------------------------------------------------------------
Property Let connectionString(ByVal str As String)
  connectionString_ = str
End Property

'---------------------------------------------------------------------------------------
' Procedure : connectionString(Getter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : データベース接続文字列を返す
'---------------------------------------------------------------------------------------
Property Get connectionString() As String
  connectionString = connectionString_
End Property

'---------------------------------------------------------------------------------------
' Procedure : dbConnecttion(Getter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : データベースコネクションを返す
' return    : ADODB.Connection
'---------------------------------------------------------------------------------------
Property Get dbConnecttion() As ADODB.Connection
  
  On Error GoTo ErrHandle
    
  If cn_ Is Nothing Then Set cn_ = New ADODB.Connection
  
  If (cn_.State And adStateOpen) <> adStateOpen Then
    cn_.connectionString = Me.connectionString & Me.dbPath
    cn_.Open
  End If
  
  Set dbConnecttion = cn_
    
  Exit Property

ErrHandle:
  Me.errorMessage = "ErrNum:" & Err.Number & " Descs:" & Err.Description & " Source:" & Err.Source
End Property

'---------------------------------------------------------------------------------------
' Procedure : errorMessage(Setter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : エラーメッセージを代入
' Param     : msg エラーメッセージ
'---------------------------------------------------------------------------------------
Property Let errorMessage(ByVal msg As String)
  errorMessage_ = msg & vbCrLf & errorMessage_
End Property

'---------------------------------------------------------------------------------------
' Procedure : errorMessage(Getter)
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : エラーメッセージを返す
'---------------------------------------------------------------------------------------
Property Get errorMessage() As String
  errorMessage = errorMessage_
End Property

'---------------------------------------------------------------------------------------
' Procedure : Class_Initialize
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : コンストラクタ
'---------------------------------------------------------------------------------------
Private Sub Class_Initialize()

  On Error GoTo ErrHandle
    
  Me.dbPath = ThisWorkbook.Path & "\" & ACCESS_DB_NAME
  Me.connectionString = CONNECTION_STRING_ACCESS_2010
  
  transLevel_ = TRANS_LEVEL_DEFAULT
  
  Exit Sub
    
ErrHandle:
  Me.errorMessage = "ErrNum:" & Err.Number & " Descs:" & Err.Description & " Source:" & Err.Source
End Sub

'---------------------------------------------------------------------------------------
' Procedure : Class_Terminate
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : デストラクタ
'---------------------------------------------------------------------------------------
Private Sub Class_Terminate()

  On Error GoTo ErrHandle

  If Not cn_ Is Nothing Then
    
    If transLevel_ > TRANS_LEVEL_DEFAULT Then cn_.RollbackTrans

    If cn_.State <> adStateClosed Then cn_.Close
    
  End If

  Set cn_ = Nothing
    
  Exit Sub
    
ErrHandle:
  MsgBox "ErrNum:" & Err.Number & " Descs:" & Err.Description & " Source:" & Err.Source, _
    vbCritical, "Error: hlpAdoConnect#Class_Terminate()"
End Sub

'---------------------------------------------------------------------------------------
' Procedure : beginTransaction
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : トランザクションを開始する
' Param     : null
' Return    : トランザクションレベル
'---------------------------------------------------------------------------------------
Function beginTransaction() As Long

  On Error GoTo ErrHandle

  'BeginTransメソッドは 1以上の値を返す
  transLevel_ = cn_.BeginTrans
  
  beginTransaction = transLevel_
  
  Exit Function

ErrHandle:
  Me.errorMessage = "ErrNum:" & Err.Number & " Descs:" & Err.Description & " Source:" & Err.Source
End Function

'---------------------------------------------------------------------------------------
' Procedure : commitTransction
' Author    : jsuo
' Date      : 2013/11/01
' Purpose   : トランザクションをコミットする
' Param     : null
'---------------------------------------------------------------------------------------
Sub commitTransction()

  On Error GoTo ErrHandle
    
  cn_.CommitTrans
  transLevel_ = TRANS_LEVEL_DEFAULT
    
  Exit Sub

ErrHandle:
  Me.errorMessage = "ErrNum:" & Err.Number & " Descs:" & Err.Description & " Source:" & Err.Source
End Sub

フォントの色が変です。ご了承下さい。