Visual Basic 6とデータベース - ODBC

概要

Visual Basic 6でODBCを使用する場合、一般的にADODB (ActiveX Data Objects) を使用する。
ADODBは、ODBCを含む様々なデータソースに対して統一的なインターフェースを提供している。

代替手段として、RDO (Remote Data Objects) や DAO (Data Access Objects) も選択できるが、ADODBが最も一般的で機能が豊富である。

SQL Server

SQL Serverへの接続

 ' SQL Serverへの接続を行う
 Private Function ConnectDatabase() As ADODB.Connection
    On Error GoTo ErrorHandler
 
    Dim conn As New ADODB.Connection
 
    ' 接続文字列の設定
    conn.ConnectionString = "Driver={SQL Server};" & _
                            "Server=<DBサーバ名>;" & _
                            "Database=<データベース名>;" & _
                            "Uid=<ユーザID>;" & _
                            "Pwd=<パスワード>;"
 
    ' データベースに接続
    conn.Open
 
    Set ConnectDatabase = conn
    Exit Function
 
 ErrorHandler:
    MsgBox "データベース接続エラー:" & vbCrLf & Err.Description, vbCritical
    Set ConnectDatabase = Nothing
 End Function

レコードの取得

 ' レコードを取得する
 Private Sub GetRecords()
    On Error GoTo ErrorHandler
 
    Dim conn As ADODB.Connection
    Dim rs As New ADODB.Recordset
 
    ' データベースに接続
    Set conn = ConnectDatabase()
    If conn Is Nothing Then Exit Sub
 
    ' SQLの実行
    rs.Open "SELECT * FROM <テーブル名> WHERE <条件式>", conn, adOpenStatic, adLockReadOnly
 
    ' 結果の処理
    Do While Not rs.EOF
       ' ここでレコードの処理
       Debug.Print rs.Fields("列名").Value
       rs.MoveNext
    Loop
 
 CleanUp:
    ' リソースの解放
    If Not rs Is Nothing Then
       If rs.State = adStateOpen Then rs.Close
       Set rs = Nothing
    End If
    If Not conn Is Nothing Then
       If conn.State = adStateOpen Then conn.Close
       Set conn = Nothing
    End If
    Exit Sub
 
 ErrorHandler:
    MsgBox "データ取得エラー:" & vbCrLf & Err.Description, vbCritical
    Resume CleanUp
 End Sub

レコード更新

 ' レコードを更新する
 Private Sub UpdateRecord(ByVal ID As Long, ByVal NewValue As String)
    On Error GoTo ErrorHandler
 
    Dim conn As ADODB.Connection
    Dim cmd As New ADODB.Command
 
    ' データベースに接続
    Set conn = ConnectDatabase()
    If conn Is Nothing Then Exit Sub
 
    ' コマンドの設定
    With cmd
       Set .ActiveConnection = conn
           .CommandType = adCmdText
           .CommandText = "UPDATE <テーブル名> SET <列名> = ? WHERE ID = ?"
           .Parameters.Append .CreateParameter("@Value", adVarChar, adParamInput, 50, NewValue)
           .Parameters.Append .CreateParameter("@ID", adInteger, adParamInput, , ID)
           .Execute
    End With
 
 CleanUp:
    ' リソースの解放
    If Not conn Is Nothing Then
       If conn.State = adStateOpen Then conn.Close
       Set conn = Nothing
    End If
    Exit Sub
 
 ErrorHandler:
    MsgBox "データ更新エラー:" & vbCrLf & Err.Description, vbCritical
    Resume CleanUp
 End Sub

レコードの追加

 ' レコードを追加する
 Private Sub InsertRecord(ByVal Value1 As String, ByVal Value2 As Long)
    On Error GoTo ErrorHandler
 
    Dim conn As ADODB.Connection
    Dim cmd As New ADODB.Command
 
    ' データベースに接続
    Set conn = ConnectDatabase()
    If conn Is Nothing Then Exit Sub
 
    ' コマンドの設定
    With cmd
       Set .ActiveConnection = conn
       .CommandType = adCmdText
       .CommandText = "INSERT INTO <テーブル名> (<列名1>, <列名2>) VALUES (?, ?)"
       .Parameters.Append .CreateParameter("@Value1", adVarChar, adParamInput, 50, Value1)
       .Parameters.Append .CreateParameter("@Value2", adInteger, adParamInput, , Value2)
       .Execute
    End With
 
 CleanUp:
    ' リソースの解放
    If Not conn Is Nothing Then
       If conn.State = adStateOpen Then conn.Close
       Set conn = Nothing
    End If
    Exit Sub
 
 ErrorHandler:
    MsgBox "データ追加エラー:" & vbCrLf & Err.Description, vbCritical
    Resume CleanUp
 End Sub

レコードの削除

 ' レコードを削除する
 Private Sub DeleteRecord(ByVal ID As Long)
    On Error GoTo ErrorHandler
 
    Dim conn As ADODB.Connection
    Dim cmd As New ADODB.Command
 
    ' データベースに接続
    Set conn = ConnectDatabase()
    If conn Is Nothing Then Exit Sub
 
    ' コマンドの設定
    With cmd
       Set .ActiveConnection = conn
           .CommandType = adCmdText
           .CommandText = "DELETE FROM <テーブル名> WHERE ID = ?"
           .Parameters.Append .CreateParameter("@ID", adInteger, adParamInput, , ID)
           .Execute
    End With
 
 CleanUp:
    ' リソースの解放
    If Not conn Is Nothing Then
       If conn.State = adStateOpen Then conn.Close
       Set conn = Nothing
    End If
    Exit Sub
 
 ErrorHandler:
    MsgBox "データ削除エラー:" & vbCrLf & Err.Description, vbCritical
    Resume CleanUp
 End Sub