SqlServer接続

Option Explicit

Private mCon As ADODB.Connection
Const ConSqlServer_Sedori = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Data Source=----------;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=HOME-PC;Use Encryption for Data=False;Tag with column collation when possible=False;Initial Catalog=master"

' Connectionオブジェクトを生成
Private Sub Class_Initialize()
   
    Set mCon = New ADODB.Connection
    mCon.CursorLocation = adUseClient
    mCon.Open ConSqlServer_Sedori
End Sub

' データベースへの接続を解除する
Private Sub Class_Terminate()
    mCon.Close
    Set mCon = Nothing
End Sub

' 引数のSQL文を実行し、ADODB.Recordsetを返す
Public Property Get Get_ADODBRec(ByVal strSQL As String) As ADODB.Recordset
    Dim rs As New ADODB.Recordset

    ' タイムアウト設定 (20分)
    mCon.CommandTimeout = 60 * 20

    ' 処理された行数を示すメッセージが結果セットの一部として返されないようにする
    mCon.Execute ("SET NOCOUNT ON")

    ' 警告メッセージが結果セットの一部として返されないようにする
    mCon.Execute ("SET ANSI_WARNINGS OFF")

    ' オーバーフローおよび0除算時にはNULLを返す
    mCon.Execute ("SET ARITHABORT OFF")

    rs.Open strSQL, mCon, adOpenStatic, adLockBatchOptimistic

    Do
        ' レコードの操作ができるオブジェクト若しくは次のRecordSetがとれず、コネクションが空になった場合終了
        If rs.State = adStateOpen Or rs.ActiveConnection Is Nothing Then
            Exit Do
        End If
        Set rs = rs.NextRecordset()
    Loop

    Set Get_ADODBRec = rs

    ' 設定OFF
    mCon.Execute ("SET NOCOUNT OFF")
    mCon.Execute ("SET ANSI_WARNINGS ON")
    mCon.Execute ("SET ARITHABORT ON")
End Property

' トランザクションを開始する
Public Sub BeginTransaction()
    mCon.BeginTrans
End Sub

' トランザクションをコミットする
Public Sub CommitTransaction()
    mCon.CommitTrans
End Sub

' トランザクションをロールバックする
Public Sub RollbackTransaction()
    mCon.RollbackTrans
End Sub
Public Property Get Get_TableID() As ADODB.Recordset
    Dim sql As String
    sql = "select name FROM sys.tables order by name"
    Set Get_TableID = Get_ADODBRec(sql)
End Property