VBAクラスの全コード:トランザクション処理
SQL入門の「トランザクション処理」時点のVBAクラスの全コードです。
ADOを使ったDB接続のVBAクラスの全コード
Option Explicit
'シートクリア列挙
Public Enum enmClear
None
Clear
ClearContents
End Enum
'DB接続情報の定数
Private Const defConStr As String = "DRIVER=【DRIVER】;Database=【DATABASE】"
Private Const defDriver As String = "SQLite3 ODBC Driver"
'DB接続情報
Private pAdoCon As ADODB.Connection
Private pAdoCmd As ADODB.Command
Private pConStr As String
Private pDataBase As String
Private pDriver As String
'トランザクション制御
Private pTransaction As Boolean
'エラー情報
Private pErrNum As Long
Private pErrMsg As String
Private pErrPrc As String
'##### DB接続設定プロパティ #####
'コネクション
Public Property Set AdoCon(arg As ADODB.Connection)
Set pAdoCon = arg
End Property
Public Property Get AdoCon() As ADODB.Connection
Set AdoCon = pAdoCon
End Property
'コマンド
Public Property Set AdoCmd(arg As ADODB.Command)
Set pAdoCmd = arg
End Property
Public Property Get AdoCmd() As ADODB.Command
Set AdoCmd = pAdoCmd
End Property
'コネクション文字列
Public Property Let ConStr(arg As String)
pConStr = arg
End Property
Public Property Get ConStr() As String
ConStr = pConStr
End Property
'データベース
Public Property Let DataBase(arg As String)
pDataBase = arg
End Property
Public Property Get DataBase() As String
DataBase = pDataBase
End Property
'ドライバー
Public Property Let Driver(arg As String)
pDriver = arg
End Property
Public Property Get Driver() As String
Driver = pDriver
End Property
'##### エラー情報プロパティ #####
'エラー番号
Public Property Get ErrNum() As Long
ErrNum = pErrNum
End Property
'エラーメッセージ
Public Property Get ErrMsg() As String
ErrMsg = pErrMsg
End Property
'エラー発生プロシージャー
Public Property Get ErrPrc() As String
ErrPrc = pErrPrc
End Property
'##### トランザクション #####
'トランザクション開始
Public Function BeginTrans() As Boolean
On Error GoTo Err_Exit
If Not Me.DbOpen Then Exit Function
Me.AdoCon.BeginTrans
pTransaction = True
BeginTrans = True
Exit Function
Err_Exit:
BeginTrans = False
Call setErr(Err, "BeginTrans")
End Function
'コミット
Public Function CommitTrans() As Boolean
On Error GoTo Err_Exit
Me.AdoCon.CommitTrans
pTransaction = False
CommitTrans = True
Exit Function
Err_Exit:
CommitTrans = False
Call setErr(Err, "CommitTrans")
End Function
'ロールバック
Public Function RollbackTrans() As Boolean
On Error Resume Next
Me.AdoCon.RollbackTrans
pTransaction = False
RollbackTrans = True
End Function
'コミット&クローズ
Public Function CommitAndClose() As Boolean
If Me.CommitTrans Then Exit Function
If Me.DbClose Then Exit Function
CommitAndClose = True
End Function
'ロールバック&クローズ
Public Function RollbackAndClose() As Boolean
If Me.RollbackTrans Then Exit Function
If Me.DbClose Then Exit Function
RollbackAndClose = True
End Function
'##### SQL実行:Connectionオブジェクト #####
'SQL実行:影響を受けたレコード数を戻す
Public Function ExecuteNonQuery(sSql As String, _
Optional RecordsAffected As Long) _
As Boolean
On Error GoTo Err_Exit
'接続状態の退避と接続
Dim isConnect As Boolean
If Not Me.AdoCon Is Nothing Then isConnect = CBool(Me.AdoCon.State)
If Not Me.DbOpen Then Exit Function
'SQLの発行
Call Me.AdoCon.Execute(sSql, RecordsAffected)
'当初接続されていなかった時は切断
If Not isConnect Then
If Not Me.DbClose Then Exit Function
End If
ExecuteNonQuery = True
Call resetErr
Exit Function
Err_Exit:
ExecuteNonQuery = False
Call setErr(Err, "ExecuteNonQuery")
End Function
'SQL実行:レコードセットを戻す
Public Function ExecuteRecordset(sSql As String, _
adoRs As ADODB.Recordset) _
As Boolean
On Error GoTo Err_Exit
'接続されていない場合は接続
If Not Me.DbOpen Then Exit Function
'SQLの発行
Set adoRs = AdoCon.Execute(sSql)
ExecuteRecordset = True
Call resetErr
Exit Function
Err_Exit:
ExecuteRecordset = False
Call setErr(Err, "ExecuteRecordset")
End Function
'##### SQL実行:Recordsetオブジェクト #####
'SQL実行:レコードセットオープン
Public Function RecordsetOpen(sSql As String, _
adoRs As ADODB.Recordset, _
Optional aCursorType As CursorTypeEnum = adOpenKeyset, _
Optional aLockType As LockTypeEnum = adLockReadOnly) _
As Boolean
On Error GoTo Err_Exit
'接続されていない場合は接続
If Not Me.DbOpen Then Exit Function
'SQL指定してレコードセットオープン
Call adoRs.Open(sSql, Me.AdoCon, adOpenKeyset, aCursorType, aLockType)
RecordsetOpen = True
Call resetErr
Exit Function
Err_Exit:
RecordsetOpen = False
Call setErr(Err, "ExecuteRecordset")
End Function
'SQL実行:ワークシートに貼り付け
Public Function SheetFromRecordset(sSql As String, _
aRange As Range, _
Optional aClear As enmClear = enmClear.None, _
Optional isHeader As Boolean = False) _
As Boolean
On Error GoTo Err_Exit
'オプション:シートクリア
Dim ws As Worksheet
Set ws = aRange.Worksheet
Select Case aClear
Case enmClear.Clear
ws.Range(aRange, ws.Cells.SpecialCells(xlCellTypeLastCell)).Clear
Case enmClear.ClearContents
ws.Range(aRange, ws.Cells.SpecialCells(xlCellTypeLastCell)).ClearContents
End Select
'接続状態の退避と接続
Dim isConnect As Boolean
If Not Me.AdoCon Is Nothing Then isConnect = CBool(Me.AdoCon.State)
If Not Me.DbOpen Then Exit Function
Dim adoRs As New ADODB.Recordset
If Not Me.RecordsetOpen(sSql, adoRs) Then Exit Function
'カラム名出力
Dim i As Long
If isHeader Then
For i = 0 To adoRs.Fields.Count - 1
aRange.Item(1, i + 1).Value = adoRs.Fields(i).Name
Next
End If
'指定セルにデータ貼り付け
Call aRange.Offset(IIf(isHeader, 1, 0)).CopyFromRecordset(adoRs)
'当初接続されていなかった時は切断
If Not isConnect Then
If Not Me.DbClose Then Exit Function
End If
SheetFromRecordset = True
Call resetErr
Exit Function
Err_Exit:
SheetFromRecordset = False
Call setErr(Err, "ExecuteRecordset")
End Function
'##### SQL実行:Commandオブジェクト #####
'CommandにSQLを設定
Public Function SetCommandText(sSql As String) As Boolean
On Error GoTo Err_Exit
Set Me.AdoCmd = New ADODB.Command
Set Me.AdoCmd.ActiveConnection = Me.AdoCon
Me.AdoCmd.CommandText = sSql
SetCommandText = True
Call resetErr
Exit Function
Err_Exit:
SetCommandText = False
Call setErr(Err, "SetCommandText")
End Function
'SQL実行:CommandのParametersを使用
Public Function ExecuteCommand(vParam As Variant) As Boolean
On Error GoTo Err_Exit
Call Me.AdoCmd.Execute(Parameters:=vParam)
ExecuteCommand = True
Call resetErr
Exit Function
Err_Exit:
ExecuteCommand = False
Call setErr(Err, "ExecuteCommand")
End Function
'##### DB接続/切断 #####
'DB接続
Public Function DbOpen() As Boolean
On Error GoTo Err_Exit
DbOpen = True
'既に接続してたら無視
If Not Me.AdoCon Is Nothing Then
If Me.AdoCon.State = ObjectStateEnum.adStateOpen Then
Exit Function
End If
End If
'SQLiteに接続
Set Me.AdoCon = New ADODB.Connection
Me.AdoCon.Open getConStr
Call resetErr
Exit Function
Err_Exit:
DbOpen = False
Call setErr(Err, "dbOpen")
End Function
'DB切断
Public Function DbClose() As Boolean
On Error GoTo Err_Exit
DbClose = True
'既に切断されていたら無視
If Me.AdoCon Is Nothing Then Exit Function
If Me.AdoCon.State = ObjectStateEnum.adStateClosed Then Exit Function
'SQLiteを切断
Me.AdoCon.Close
Call resetErr
Exit Function
Err_Exit:
DbClose = False
Call setErr(Err, "dbOpen")
End Function
'##### クラスのイベント #####
'初期処理
Private Sub Class_Initialize()
Me.Driver = defDriver
Me.ConStr = defConStr
End Sub
'終了処理
Private Sub Class_Terminate()
Call Me.DbClose
End Sub
'##### エラー情報 #####
'エラー情報設定
Private Sub setErr(objErr As ErrObject, _
ErrPrc As String)
pErrNum = objErr.Number
pErrMsg = objErr.Description
pErrPrc = ErrPrc
If pTransaction Then Me.RollbackTrans
End Sub
'エラー情報クリア
Private Sub resetErr()
pErrNum = 0
pErrMsg = ""
pErrPrc = ""
End Sub
'##### 汎用関数等 #####
'DB接続文字列
Private Function getConStr() As String
getConStr = Me.ConStr
getConStr = Replace(getConStr, "【DRIVER】", Me.Driver)
getConStr = Replace(getConStr, "【DATABASE】", Me.DataBase)
End Function
同じテーマ「SQL入門」の記事
データの更新(UPDATE)
データの削除(DELETE)
他のテーブルのデータで追加/更新/削除
インデックスを作成して高速化(CREATE INDEX)
トランザクション処理
VBAクラスの全コード:トランザクション処理
サブクエリ(副問合せ)
サブクエリのネストとSQLコメント&整形
WITH句(共通テーブル式)
取得行数を限定するLIMIT句
分析関数(OVER句,WINDOW句)
新着記事NEW ・・・新着記事一覧を見る
TRIMRANGE関数(セル範囲をトリム:端の空白セルを除外)|エクセル入門(2024-08-30)
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.セルのクリア(Clear,ClearContents)|VBA入門
8.条件分岐(Select Case)|VBA入門
9.メッセージボックス(MsgBox関数)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。