Excel からデータベーステーブルの操作

テーブルへの接続とレコードの取得

目的に応じた接続形態を取る

Open メソッドの引数を指定して実行する

Sub レコード取得1()
'Open メソッドの引数を指定して実行する
Dim myCon As New ADODB.Connection, myRS As New ADODB.Recordset, FileName As String

FileName = ThisWorkbook.Path & "\mdb\2-sampleDB.mdb"
myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName

'「社員」テーブルの内容を変更できる状態で開く
myRS.Open "社員", myCon, adOpenDynamic, adLockPessimistic

Range("A1").CopyFromRecordset myRS

myRS.Close: Set myRS = Nothing
myCon.Close: Set myCon = Nothing

End Sub

対応するプロパティに値を設定して開く

Sub レコード取得2()
'対応するプロパティに値を設定して開く
Dim myCon As New ADODB.Connection, myRS As New ADODB.Recordset, FileName As String

FileName = ThisWorkbook.Path & "\mdb\2-sampleDB.mdb"
myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName

With myRS
.Source = "社員"
.ActiveConnection = myCon
.CursorType = adOpenDynamic
.LockType = adLockPessimistic '「社員」テーブルの内容を変更できる状態で開く
.Open
End With

Range("A1").CopyFromRecordset myRS

myRS.Close: Set myRS = Nothing
myCon.Close: Set myCon = Nothing

End Sub

Supportメソッドの利用

Sub レコードセットの機能調査()
Dim myCon As New ADODB.Connection, myRS As New ADODB.Recordset
Dim FileName As String

FileName = ThisWorkbook.Path & "\mdb\2-sampleDB.mdb"
myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName
myRS.Open "社員", myCon, adOpenStatic, adLockReadOnly

'レコードセットの機能を調査するプロシージャ呼び出し
Call ADOSupport(myRS)

myRS.Close: Set myRS = Nothing
myCon.Close: Set myCon = Nothing

End Sub

Sub ADOSupport(myRecordset As Object)
'レコードセットの機能を調査する
Dim strMsg As String

If myRecordset.Supports(adApproxPosition) Then
    strMsg = "OK ： AbsolutePositionプロパティとAbsolutePageプロパティをサポートします。"
Else
    strMsg = "NO ： AbsolutePositionプロパティとAbsolutePageプロパティをサポートしていません。"
End If

If myRecordset.Supports(adAddNew) Then
    strMsg = strMsg & vbNewLine & _
            "OK ： 新規レコードを追加するAddNewメソッドをサポートします。"
Else
    strMsg = strMsg & vbNewLine & _
            "NO ： 新規レコードを追加するAddNewメソッドをサポートしません。"
End If

If myRecordset.Supports(adBookmark) Then
    strMsg = strMsg & vbNewLine & _
            "OK ： 特定のレコードへのアクセスを確保するBookmarkプロパティをサポートします。"
Else
    strMsg = strMsg & vbNewLine & _
            "NO ： 特定のレコードへのアクセスを確保するBookmarkプロパティをサポートしません。"
End If

If myRecordset.Supports(adDelete) Then
    strMsg = strMsg & vbNewLine & _
            "OK ： レコードを削除する Delete メソッドをサポートします。"
Else
    strMsg = strMsg & vbNewLine & _
            "NO ： レコードを削除する Delete メソッドをサポートしません。"
End If

If myRecordset.Supports(adFind) Then
    strMsg = strMsg & vbNewLine & _
            "OK ： Recordset 内の行の位置を確認するFindメソッドをサポートします。"
Else
    strMsg = strMsg & vbNewLine & _
            "NO ： Recordset 内の行の位置を確認するFindメソッドをサポートしません。"
End If

If myRecordset.Supports(adIndex) Then
    strMsg = strMsg & vbNewLine & _
            "OK ： インデックスに名前を付けるIndexプロパティをサポートします。"
Else
    strMsg = strMsg & vbNewLine & _
            "NO ： インデックスに名前を付けるIndexプロパティをサポートしません。"
End If

If myRecordset.Supports(adMovePrevious) Then
    strMsg = strMsg & vbNewLine & _
            "OK ： カレントレコードの位置を後方に移動するMoveFirst、" & _
            "MovePrevious、Move、GetRowsメソッドをサポートします。"
Else
    strMsg = strMsg & vbNewLine & _
            "NO ： カレントレコードの位置を後方に移動するMoveFirst、" & _
            "MovePrevious、Move、GetRowsメソッドをサポートしません。"
End If

If myRecordset.Supports(adSeek) Then
    strMsg = strMsg & vbNewLine & _
            "OK ： Recordset 内の行に割り当てるSeekメソッドをサポートします。"
Else
    strMsg = strMsg & vbNewLine & _
            "NO ： Recordset 内の行に割り当てるSeekメソッドをサポートしません。"
End If

If myRecordset.Supports(adUpdate) Then
    strMsg = strMsg & vbNewLine & _
            "OK ： 既存のデータを変更するUpdateメソッドをサポートします。"
Else
    strMsg = strMsg & vbNewLine & _
            "NO ： 既存のデータを変更するUpdateメソッドをサポートしません。"
End If

Debug.Print strMsg

End Sub