Windows 10 Pro_x64 + Excel2013_x86 VBA DataBase Access クラス

・DataBase アクセスのためのクラスモジュールの実装例
・登録済のODBCを使用する Connectを修正すれば、他でもわりと流用可のはず
・基本的に引数のSQLを実行して、その結果を返す
・Access でもそのまま動作することを確認済
・.Net系もベースはこれだろうからそのうち書いてみる
ツール->参照設定　より以下をチェックする
Microsoft ActiveX Data Object 6.0 Library
・接続はODBCを設定して使用する
・UserName, Password, DBName の文字列はプロパティを使用する
Option Explicit

Dim m_UserName      As String
Dim m_Password      As String
Dim m_DBName        As String
Dim m_ConStr        As String
Dim m_trnLevel      As Long

Dim adoCon          As ADODB.Connection
Dim adoRst          As ADODB.Recordset

'===========================================================
' 機 能 : コンストラクタ
'===========================================================
Private Sub Class_Initialize()
'
    Set adoCon = Nothing
    m_DBName = Space(0)
    m_UserName = Space(0)
    m_Password = Space(0)
    m_ConStr = Space(0)
'
End Sub

'===========================================================
' 機 能 : デストラクタ
'===========================================================
Private Sub Class_Terminate()
'
    If NZInt(adoCon) > adStateClosed Then
        If adoCon.State > adStateClosed Then DisConnect
    End If

End Sub

'===========================================================
' 機 能 : DB接続ユーザー名
'===========================================================
Public Property Let UserName(aUserName As String)
    m_UserName = nzStr(aUserName)
End Property
Public Property Get UserName() As String
    UserName = m_UserName
End Property

'===========================================================
' 機 能 : DB接続パスワード
'===========================================================
Public Property Let Password(aPassword As String)
    m_Password = nzStr(aPassword)
End Property
Public Property Get Password() As String
    Password = m_Password
End Property

'===========================================================
' 機 能 : 接続DB名
'===========================================================
Public Property Let DBName(aDBName As String)
    m_DBName = nzStr(aDBName)
End Property
Public Property Get DBName() As String
    DBName = m_DBName
End Property

'===========================================================
' 機 能 : BeginTrans の実行
'===========================================================
Public Function BeginTrans() As Boolean
On Error GoTo ERRPROC
'
    adoCon.BeginTrans
    m_trnLevel = m_trnLevel + 1
    BeginTrans = True
'
    Exit Function
'
ERRPROC:
    BeginTrans = False
End Function

'===========================================================
' 機 能 : CommitTransの実行
'===========================================================
Public Function CommitTrans() As Boolean
On Error GoTo ERRPROC
'
    adoCon.CommitTrans
    m_trnLevel = m_trnLevel - 1
    CommitTrans = True
'
    Exit Function
'
ERRPROC:
    CommitTrans = False
End Function

'===========================================================
' 機 能 : RollbackTrans の実行
'===========================================================
Public Function RollbackTrans() As Boolean
On Error GoTo ERRPROC
'
    adoCon.RollbackTrans
    m_trnLevel = m_trnLevel - 1
    RollbackTrans = True
'
    Exit Function
'
ERRPROC:
    RollbackTrans = False
End Function

'===========================================================
' 機 能 : Transactionのステータス
'===========================================================
Public Function isTransaction() As Boolean
'
    If m_trnLevel > 0 Then
        isTransaction = True
    Else
        isTransaction = False
    End If
End Function

'===========================================================
' 機 能 : SELECt COUNT(*) 専用
' 復 帰 値 : 個数
' パラメータ : astrSQL : 実行するSQL文
'===========================================================
Public Function SelectCount(astrSQL As String) As Long
On Error GoTo ERRPROC
'
    Set adoRst = Nothing
    Set adoRst = adoCon.Execute(astrSQL, adExecuteRecord)
    SelectCount = adoRst.Fields(0)
'
    Exit Function
'
ERRPROC:
    SelectCount = 0
End Function

'===========================================================
' 機 能 : データを検索して取得データを返す
' 復 帰 値 : True : OK / False : NG
' パラメータ : astrSQL : 実行するSQL文
'            : adoRst  : 取得データ
'===========================================================
Public Function SelectData(astrSQL As String, adoRst As Recordset) As Boolean
On Error GoTo ERRPROC
'
    Set adoRst = Nothing
    Set adoRst = adoCon.Execute(astrSQL, adExecuteNoRecords)
    SelectData = True
'
    Exit Function
'
ERRPROC:
    Set adoRst = Nothing
    SelectData = False
End Function

'===========================================================
' 機 能 : SQLを実行して、その結果を返す
' 復 帰 値 : True : OK / False : NG
' パラメータ : astrSQL   : 実行するSQL文
'===========================================================
Public Function ExecuteSQL(astrSQL As String) As Boolean
On Error GoTo ERRPROC
'
    Call adoCon.Execute(astrSQL)
    ExecuteSQL = True

    Exit Function

ERRPROC:
    ExecuteSQL = False
End Function

'===========================================================
' 名 称 : Connect
' 機 能 : DBとの接続を確立する
'===========================================================
Public Function Connect() As Boolean
On Error GoTo ERRPROC
'
    If NZInt(adoCon) = adStateClosed Then
        m_ConStr = "DSN=" & m_DBName & ";UID=" & m_UserName & ";PWD=" & m_Password
        Set adoCon = New ADODB.Connection
        adoCon.ConnectionString = m_ConStr
        adoCon.CursorLocation = adUseClient     ' 追加しないと adoRst.RecordCount = -1 に固定となる
'
        m_trnLevel = 0
        Call adoCon.Open
    End If
'
    Connect = True
    Exit Function
'
ERRPROC:
    Call DisConnect
    Connect = False
End Function

'===========================================================
' 名 称 : isConnect
' 機 能 : 接続ステータス
'===========================================================
Public Function isConnect() As Boolean
'
    If NZInt(adoCon) = adStateClosed Then
        isConnect = False
    Else
        If adoCon.State = adStateClosed Then
            isConnect = False
        Else
            isConnect = True
        End If
    End If
'
    Exit Function
'
ERRPROC:
    isConnect = False
End Function

'===========================================================
' 名 称 : DisConnect
' 機 能 : DBとの接続を閉じる
'===========================================================
Public Function DisConnect() As Boolean
'
    m_trnLevel = 0
    Set adoCon = Nothing
    DisConnect = True
'
End Function

'-------------- 以下は他のモジュールで共用する -------------

'===========================================================
' 機 能 : Null値の場合０に変換する。
' 復 帰 値 : 判定結果
' パラメータ : vValue:文字列
'===========================================================
Public Function NZInt(ByVal vValue As Variant) As Integer
'
    If IsNumeric(vValue) And (IsNull(vValue) Or IsEmpty(vValue)) Then
        NZInt = Fix(vValue)
    Else
        NZInt = 0
    End If
'
End Function

'=================================================================
' 機 能 : Null, Nothing, Empty は文字列長ゼロに変換する。
' 復 帰 値 : 判定結果
' パラメータ : vValue:文字列
'=================================================================
Public Function NZStr(ByVal vValue As Variant) As String
'
    If VarType(vValue) = vbObject Then
        NZStr = Space(0)
    ElseIf IsNull(vValue) Or IsEmpty(vValue) Then
        NZStr = Space(0)
    Else
        NZStr = RTrim(CStr(vValue))
    End If
'
End Function