【VBA】DBUtil

Option Explicit

'v1
'****************************************************
'データベース操作クラス
'----------------------------------------------------
'DBUtil
'----------------------------------------------------
'参照設定
'   Microsoft ActiveX Data Objects 2.8 Library
'****************************************************
'DBOpen              -DB接続
'DBClose             -DB切断
'RecOpen             -レコードセットオープン
'ExecSQL             -SQL実行（INSERT、DELETE等）
'PasteRec            -レコードセットをセルに張り付け
'BeginTrans          -トランザクション開始
'CommitTrans         -コミット
'RollbackTrans       -ロールバック
'****************************************************

'プロパティ
Public Oracle_ホスト名 As String
Public Oracle_ポート As String
Public Oracle_サービス名 As String
Public OracleTNS_ネットサービス名 As String
Public PostgreSql_サーバー名 As String
Public PostgreSql_データベース名 As String
Public PostgreSqlODBC_DSN As String
Public ユーザID As String
Public パスワード As String

'定数
Private Const CONSTR_ORACLE As String = "Provider=OraOLEDB.Oracle;" _
                        & "Data Source=(DESCRIPTION=(ADDRESS=(PROTOCOL=TCP)" _
                        & "(HOST=【HOST】)" _
                        & "(PORT=【PORT】))" _
                        & "(CONNECT_DATA=(SERVICE_NAME=【SERVICE_NAME】)))" _
                        & ";USER ID= 【USER ID】" _
                        & ";PASSWORD= 【PASSWORD】"
Private Const CONSTR_ORACLE_TNS As String = "PROVIDER=OraOLEDB.Oracle;DATA SOURCE=【DATA SOURCE】;USER ID=【USER ID】;PASSWORD=【PASSWORD】"
Private Const CONSTR_POSTGRESQL As String = "DRIVER=PostgreSQL Unicode;DATABASE=【DATABASE】;SERVER=【SERVER】;UID=【UID】;PWD=【PWD】"
Private Const CONSTR_POSTGRESQL_ODBC As String = "DSN=【DSN】"

'選択肢
Public Enum enmDBtype
    Oracle
    Oracle_TNS
    PostgreSQL
    PostgreSQL_ODBC
End Enum

'内部用
Private adoCon As ADODB.Connection
Private adoCmd As ADODB.Command

'------------------------------------------------------
'◆デコンストラクタ
'------------------------------------------------------
Private Sub Class_Terminate()
    Me.DBClose
End Sub

'----------------------------------------------------
'■DB接続
'----------------------------------------------------
'引数：DB＆接続方法の種類
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function DBOpen(aDBType As enmDBtype) As Boolean
On Error GoTo Err
    Dim conStr As String    '接続用文字列
    Dim conStr_log As String    'ログ用文字列
    
'    '既に接続してたらエラー
'    If Not adoCon Is Nothing Then
'        If adoCon.State = ObjectStateEnum.adStateOpen Then
'            GoTo Err
'        End If
'    End If
'
    Set adoCon = New ADODB.Connection
    
    '接続文字列取得
    Select Case aDBType
        'Oracle tnsなし
        Case enmDBtype.Oracle
            conStr = GetConStr_Ora1
            conStr_log = Left(conStr, InStr(conStr, "PASSWORD=") - 1)
        'Oracle tnsあり
        Case enmDBtype.Oracle_TNS
            conStr = GetConStr_Ora2
            conStr_log = Left(conStr, InStr(conStr, "PASSWORD=") - 1)
        'PostgreSQL ODBCなし
        Case enmDBtype.PostgreSQL
            conStr = GetConStr_Pos1
            conStr_log = Left(conStr, InStr(conStr, "PWD=") - 1)
        'PostgreSQL ODBCあり
        Case enmDBtype.PostgreSQL_ODBC
            conStr = GetConStr_Pos2
            conStr_log = conStr
    End Select
    
    'DB接続
    adoCon.Open conStr
    DBOpen = True
    If logging Then AddLog "DBOpen", "INFO ", "接続文字列:" & conStr_log
    Exit Function
Err:
    DBOpen = False
    If logging Then AddLog "DBOpen", "ERROR", "接続文字列:" & conStr_log & " / エラー内容:" & Err.Description
End Function

'----------------------------------------------------
'■DB切断
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function DBClose() As Boolean
On Error GoTo Err
    DBClose = True
    '既に切断されていたら無視
    If adoCon Is Nothing Then Exit Function
    If adoCon.State = ObjectStateEnum.adStateClosed Then Exit Function
    'DB切断
    adoCon.Close
    If logging Then AddLog "DBClose", "INFO "
    Exit Function
Err:
    DBClose = False
    If logging Then AddLog "DBClose", "ERROR", "エラー内容:" & Err.Description
End Function

'----------------------------------------------------
'■レコードセットオープン
'----------------------------------------------------
'引数1：実行するSQL
'引数2：レコードセット　※結果が格納される
'引数3：(Optional)カーソルタイプ　※ﾃﾞﾌｫﾙﾄキーセット
'引数4：(Optional)ロックタイプ　※ﾃﾞﾌｫﾙﾄは読取専用
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function RecOpen(aSql As String, _
                    aRs As ADODB.Recordset, _
                    Optional aCursorType As CursorTypeEnum = adOpenKeyset, _
                    Optional aLockType As LockTypeEnum = adLockReadOnly) _
                    As Boolean
On Error GoTo Err
    'SQL指定してレコードセットオープン
    aRs.Open aSql, adoCon, aCursorType, aLockType
    RecOpen = True
    If logging Then AddLog "RecOpen", "INFO ", "SQL:" & aSql
    Exit Function
Err:
    If logging Then AddLog "RecOpen", "ERROR", "SQL:" & aSql & " / エラー内容:" & Err.Description
End Function

'----------------------------------------------------
'■SQL実行（INSERT、DELETE等）
'----------------------------------------------------
'引数1：実行するSQL
'引数2：(Optional)処理件数
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function ExecSQL(aSql As String, Optional aResultCnt As Long) As Boolean
On Error GoTo Err
    'SQL実行
    adoCon.Execute aSql, aResultCnt
    ExecSQL = True
    If logging Then AddLog "ExecSQL", "INFO ", "SQL:" & aSql
    Exit Function
Err:
    If logging Then AddLog "ExecSQL", "ERROR", "SQL:" & aSql & " / エラー内容:" & Err.Description
End Function

'------------------------------------------------------
'■レコードセットをワークシートに張り付け
'------------------------------------------------------
'引数1：張り付けるレコードセット
'引数2：貼り付け先のレンジ　※シートを指定可
'引数3：(Optional)ヘッダーの出力有無　※ﾃﾞﾌｫﾙﾄは無し
'------------------------------------------------------
Public Function PasteRec(aRs As ADODB.Recordset, aRange As Range, Optional aIsHeader As Boolean)
    'ヘッダー出力ありならヘッダーを出力
    Dim i As Long
    If aIsHeader Then
        For i = 0 To aRs.Fields.Count - 1
            aRange.item(1, i + 1).Value = aRs.Fields(i).Name
        Next
    End If
    'レコードセットを貼り付け
    Call aRange.Offset(IIf(aIsHeader, 1, 0)).CopyFromRecordset(aRs)
End Function
'----------------------------------------------------
'▼トランザクション開始
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function BeginTrans() As Boolean
On Error GoTo Err
    adoCon.BeginTrans
    BeginTrans = True
    If logging Then AddLog "BeginTrans", "INFO "
    Exit Function
Err:
    If logging Then AddLog "BeginTrans", "ERROR" & " / エラー内容:" & Err.Description
End Function

'----------------------------------------------------
'▼コミット
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function CommitTrans() As Boolean
On Error GoTo Err
    adoCon.CommitTrans
    CommitTrans = True
    If logging Then AddLog "CommitTrans", "INFO "
    Exit Function
Err:
    If logging Then AddLog "CommitTrans", "ERROR" & " / エラー内容:" & Err.Description
End Function

'----------------------------------------------------
'▼ロールバック
'----------------------------------------------------
'戻り値:実行結果　※エラーがなければTrue
'----------------------------------------------------
Public Function RollbackTrans() As Boolean
On Error Resume Next
    RollbackTrans = True
    adoCon.RollbackTrans
    If logging Then AddLog "RollbackTrans", "INFO "
End Function

'----------------------------------------------------
'▼DB接続文字列取得（Oracle tnsなし）
'----------------------------------------------------
Private Function GetConStr_Ora1() As String
    GetConStr_Ora1 = CONSTR_ORACLE
    GetConStr_Ora1 = Replace(GetConStr_Ora1, "【HOST】", Oracle_ホスト名)
    GetConStr_Ora1 = Replace(GetConStr_Ora1, "【PORT】", Oracle_ポート)
    GetConStr_Ora1 = Replace(GetConStr_Ora1, "【SERVICE_NAME】", Oracle_サービス名)
    GetConStr_Ora1 = Replace(GetConStr_Ora1, "【USER ID】", ユーザID)
    GetConStr_Ora1 = Replace(GetConStr_Ora1, "【PASSWORD】", パスワード)
End Function

'----------------------------------------------------
'▼DB接続文字列取得（Oracle tnsあり）
'----------------------------------------------------
Private Function GetConStr_Ora2() As String
    GetConStr_Ora2 = CONSTR_ORACLE_TNS
    GetConStr_Ora2 = Replace(GetConStr_Ora2, "【DATA SOURCE】", OracleTNS_ネットサービス名)
    GetConStr_Ora2 = Replace(GetConStr_Ora2, "【USER ID】", ユーザID)
    GetConStr_Ora2 = Replace(GetConStr_Ora2, "【PASSWORD】", パスワード)
End Function

'----------------------------------------------------
'▼DB接続文字列取得（PostgreSQL ODBなし）
'----------------------------------------------------
Private Function GetConStr_Pos1() As String
    GetConStr_Pos1 = CONSTR_POSTGRESQL
    GetConStr_Pos1 = Replace(GetConStr_Pos1, "【DATABASE】", PostgreSql_データベース名)
    GetConStr_Pos1 = Replace(GetConStr_Pos1, "【SERVER】", PostgreSql_サーバー名)
    GetConStr_Pos1 = Replace(GetConStr_Pos1, "【UID】", ユーザID)
    GetConStr_Pos1 = Replace(GetConStr_Pos1, "【PWD】", パスワード)
End Function

'----------------------------------------------------
'▼DB接続文字列取得（PostgreSQL ODBあり）
'----------------------------------------------------
Private Function GetConStr_Pos2() As String
    GetConStr_Pos2 = CONSTR_POSTGRESQL_ODBC
    GetConStr_Pos2 = Replace(GetConStr_Pos2, "【DSN】", PostgreSqlODBC_DSN)
End Function