Windows 10 Pro_x64 + Excel2013_x86 VBA DataBase Access クラス
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 ExplicitDim m_UserName As String
Dim m_Password As String
Dim m_DBName As String
Dim m_ConStr As String
Dim m_trnLevel As LongDim 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 IfEnd 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 = TrueExit 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
