Windows 10 Pro x64 + Excel2016 x86 VBA DataBase Access クラス 実装例

#目的
・DataBase アクセスのためのクラスモジュールの実装例
・登録済のODBC Data Source or ODBC Driver はプロジェクトの方針依存？
・基本的に引数のSQL/Commandを実行して、その結果を返す
・Access でもそのまま動作することを確認済
・.Net系もベースはこれだろうからそのうち書いてみる
・Driver、UserName, Password, DBName の文字列はプロパティを使用する
##参照設定の追加
ツール->参照設定　より以下をチェックする
Microsoft ActiveX Data Object 6.0 Library
##使用サンプルコード
[Windows 10 Pro x64 + Excel2016 x86 VBA から ODBC経由で SQLite3 にアクセスしてみる](https://qiita.com/tabizou/items/9d31f2e9352297d25106)の書換版

```vba
'=================================================================
'
'   DBCtrlクラスを使用した
'   Excel2016 VBA -> SQLite3 からの読込サンプル
'
'=================================================================
Private Sub ReadSqlite3DBCtrl()
On Error GoTo ERR_PROC

    Dim DB          As DBCtrl
    Dim adoRst      As New ADODB.Recordset
    Dim adoCmd      As New ADODB.Command
    Dim blnRet      As Boolean

    Set DB = New DBCtrl
    DB.DBName = "SQLITE3DEMO32"
    DB.UserName = ""
    DB.Password = ""
    DB.Connect

    adoCmd.CommandText = "SELECT * FROM TEST_TABLE"
    adoCmd.CommandType = adCmdText
    blnRet = DB.SelectDataCmd(adoCmd, adoRst)
    While Not adoRst.EOF
        Debug.Print adoRst.Fields("ID") & " " & adoRst.Fields("VALUE")
        adoRst.MoveNext
    Wend
    Set adoRst = Nothing
    Set adoCmd = Nothing
    Set DB = Nothing
    Exit Sub
    
ERR_PROC:
    Set adoRst = Nothing
    Set adoCmd = Nothing
    Set DB = Nothing
End Sub
</pre>
##DBクラス実装例
<pre>
Option Explicit

Dim m_ODBCDrv       As String
Dim m_DBName        As String
Dim m_UserName      As String
Dim m_Password      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_ODBCDrv = Space(0)
    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

'===========================================================
' 機 能 : ODBCドライバー名
'===========================================================
Public Property Let Driver(aDriver As String)
    m_ODBCDrv = NZStr(aDriver)
End Property
Public Property Get Driver() As String
    Driver = m_ODBCDrv
End Property

'===========================================================
' 機 能 : 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

'===========================================================
' 機 能 : SELECT COUNT(*) 専用
' 復 帰 値 : 個数
' パラメータ : aCmd   : 実行するコマンド
'===========================================================
Public Function SelectCountCmd(aCmd As ADODB.Command) As Long
On Error GoTo ERRPROC
'
    Dim adoCmd      As New ADODB.Command
'
    Set adoCmd = aCmd
    adoCmd.ActiveConnection = adoCon
'
    Set adoRst = adoCmd.Execute

    Set adoRst = Nothing
    Set adoRst = adoCmd.Execute
    SelectCountCmd = adoRst.Fields(0)
'
    Exit Function
'
ERRPROC:
    SelectCountCmd = 0
End Function

'===========================================================
' 機 能 : データを検索して取得データを返す
' 復 帰 値 : True : OK / False : NG
' パラメータ : aCmd    : 実行するコマンド
'            : adoRst  : 取得データ
'===========================================================
Public Function SelectDataCmd(aCmd As ADODB.Command, adoRst As Recordset) As Boolean
On Error GoTo ERRPROC
'
    Dim adoCmd      As New ADODB.Command
'
    Set adoCmd = aCmd
    adoCmd.ActiveConnection = adoCon
'
    Set adoRst = Nothing
    Set adoRst = adoCmd.Execute
    SelectDataCmd = True
'
    Exit Function
'
ERRPROC:
    Set adoRst = Nothing
    SelectDataCmd = False
End Function

'===========================================================
' 機 能 : コマンドを実行する
' 復 帰 値 : True : OK / False : NG
' パラメータ : aCmd   : 実行するコマンド
'===========================================================
Public Function ExecuteSQLCmd(aCmd As ADODB.Command) As Boolean
On Error GoTo ERRPROC
'
    Dim adoCmd      As New ADODB.Command
'
   Set adoCmd = aCmd
    adoCmd.ActiveConnection = adoCon
'
    Set adoRst = adoCmd.Execute
    ExecuteSQLCmd = True
    Set adoCmd = Nothing
    Exit Function

ERRPROC:
    Set adoCmd = Nothing
    ExecuteSQLCmd = False
End Function

'===========================================================
' 名 称 : Connect
' 機 能 : DBとの接続を確立する
'===========================================================
Public Function Connect() As Boolean
On Error GoTo ERRPROC
'
    If NZInt(adoCon) = adStateClosed Then
        '
        '   切替方はづするかな？
        '   どちらか一方に決めて、他方はエラーログ吐くのもありかな？
        '
'        m_ConStr = "DRIVER={" & m_ODBCDrv & "};DATABASE=" & m_DBName & ";UID=" & m_UserName & ";PWD=" & m_Password
        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
```