SQL文を実行する(ADO)Execute メソッド

サイト管理人

7年前

Command オブジェクトの Execute メソッドで、SQL文を実行

Command オブジェクトで Execute メソッドを使用すると、CommandText プロパティに指定したSQL文やクエリ等が実行されます。CommandText プロパティに結果を返す SQL文やクエリ等が指定された場合、新規の Recordset オブジェクトに保存されます。
パラメータクエリの場合は、引数の Parameters にクエリに渡すパラメータを指定します。パラメータクエリに関しての詳細は、クエリにパラメータを渡して結果を取得する（ADO）Command オブジェクト・Execute メソッドを参照してください。

Command.Execute メソッド

【書式】

＜取得＞
Set recordset = object.Execute [ ( RecordsAffected, Parameters, Options ) ]

object.Execute [ RecordsAffected, Parameters, Options ]

引数・戻り値

object ・・・対象となる Command オブジェクトを指定します。
recordset ・・・ Recordset オブジェクトを表すオブジェクト変数です。Execute メソッドの実行結果、または、Nothing を取得します。
RecordsAffected ・・・長整数型（Long）の変数を指定します。Execute メソッド実行操作によって影響を受けたレコードの数をこの変数に返します（つまり、更新クエリ・追加クエリ・削除クエリなどで変更のあったレコードの数、省略可）。
Parameters ・・・クエリに渡すパラメータをバリアント型（Variant）の配列で指定します。詳細は、クエリにパラメータを渡して結果を取得する（ADO）Command オブジェクト・Execute メソッド Parameters コレクションを参照してください。
Options ・・・ CommandText プロパティの評価を最適化するために使います。SQL文を実行するには、adCmdText を指定します。省略すると adCmdUnknown が指定されたと見なされます。

Insert Into ステートメント（レコード追加）を実行する

テーブルにレコードを１つ追加します（追加クエリ）

【書式】

INSERT INTO target [field1, field2, ・・・ ] VALUES ( value1, value2, ・・・ )

CreateObject 関数

target ・・・レコードを追加するテーブル・クエリの名前を指定します。
field1, field2, … ・・・レコードを追加するフィールド名（列名）を指定します。複数指定する場合はカンマで区切ります。
value1, value2, … ・・・新規に追加するレコードの値を指定します。それぞれの値は、記述順にフィールドに挿入されます。つまり、value1 は列（field1）に、value2 は列（value2）に挿入されます。値と値の間はカンマで区切り、テキストの値は単一引用符（’）で囲みます。

Access の場合、上記構文では一度に複数のレコードを追加することはできません。

サンプルVBAソース（レコードの追加）その１

　
Sub Sample_Command_ExecuteInsert()

    '参照設定:Microsoft ActiveX Data Objects 6.1 Library
    
    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim constr As String
    Dim DBFile As String
    Dim i As Long
    Dim j As Long
    Dim strSQL1 As String
    Dim strSQL2 As String
    Dim strSQL3 As String
    
    DBFile = ActiveWorkbook.Path & "\mydb1.accdb"
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile

    strSQL1 = "insert into " & _
              "テーブル4 (社員ID,氏名,フリガナ,性別,部署C,入社年月日) " & _
              "values ('H0051','工藤麻衣','クドウマイ','女',100,#1999/4/10#)"

    strSQL2 = "insert into " & _
              "テーブル4 (社員ID,氏名,フリガナ,性別,部署C,入社年月日) " & _
             "values ('H0055','国立浩司','クニタチコウジ','男',105,#1999/4/20#)"

    strSQL3 = "select * from テーブル4 order by 社員ID"
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = constr
    cn.Open
    
    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = cn
        
        .CommandText = strSQL1
        .Execute
        
        .CommandText = strSQL2
        .Execute
        
        .CommandText = strSQL3
        Set rs = .Execute
    End With
            
    With Worksheets("Sheet1")
        .Cells.Clear
            rs.MoveFirst
        i = 1
        .Cells.Clear
        Do Until rs.EOF
            For j = 0 To rs.Fields.Count - 1
                If i = 1 Then .Cells(i, j + 1) = rs(j).Name
                .Cells(i + 1, j + 1) = rs(j).Value
            Next j
            rs.MoveNext
            i = i + 1
        Loop
        .Columns("A:H").AutoFit
    End With
        
    Set cmd = Nothing
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

End Sub

Sub Sample_Command_ExecuteInsert()

'参照設定:Microsoft ActiveX Data Objects 6.1 Library

Dim cn As ADODB.Connection

Dim cmd As ADODB.Command

Dim rs As ADODB.Recordset

Dim constr As String

Dim DBFile As String

Dim i As Long

Dim j As Long

Dim strSQL1 As String

Dim strSQL2 As String

Dim strSQL3 As String

DBFile = ActiveWorkbook.Path & "\mydb1.accdb"

constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile

strSQL1 = "insert into " & _

"テーブル4 (社員ID,氏名,フリガナ,性別,部署C,入社年月日) " & _

"values ('H0051','工藤麻衣','クドウマイ','女',100,#1999/4/10#)"

strSQL2 = "insert into " & _

"テーブル4 (社員ID,氏名,フリガナ,性別,部署C,入社年月日) " & _

"values ('H0055','国立浩司','クニタチコウジ','男',105,#1999/4/20#)"

strSQL3 = "select * from テーブル4 order by 社員ID"

Set cn = New ADODB.Connection

cn.ConnectionString = constr

cn.Open

Set cmd = New ADODB.Command

With cmd

.ActiveConnection = cn

.CommandText = strSQL1

.Execute

.CommandText = strSQL2

.Execute

.CommandText = strSQL3

Set rs = .Execute

End With

With Worksheets("Sheet1")

.Cells.Clear

rs.MoveFirst

i = 1

.Cells.Clear

Do Until rs.EOF

For j = 0 To rs.Fields.Count - 1

If i = 1 Then .Cells(i, j + 1) = rs(j).Name

.Cells(i + 1, j + 1) = rs(j).Value

Next j

rs.MoveNext

i = i + 1

Loop

.Columns("A:H").AutoFit

End With

Set cmd = Nothing

Set rs = Nothing

cn.Close

Set cn = Nothing

End Sub

実行結果

サンプルVBAソース（レコードの追加）その２

１行の SQL文で、複数レコードを追加する場合の例です。ただし、前もって、ダミーテーブルを作成する必要があります。ダミーテーブルには、１つのレコードが必要になります。
ここでは、テーブル名「dummy」、フィールド名（列名）「AAA」（数値型）のダミーテーブルを作成

（※テーブル定義（フィールドの数、型等）はなんでも良い。ただしレコード数は１つだけにする。）

　
Sub Sample_Command_ExecuteInsert2()

    '参照設定:Microsoft ActiveX Data Objects 6.1 Library
    
    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim constr As String
    Dim DBFile As String
    Dim i As Long
    Dim j As Long
    Dim strSQL1 As String
    Dim strSQL2 As String
    Dim rcnt As Long
    
    DBFile = ActiveWorkbook.Path & "\mydb1.accdb"
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile
    
    strSQL1 = "insert into テーブル1(ID, NAME, CONTRY) " & _
             "select * from " & _
             "[ " & _
                "select " & _
                    "8 as ID, " & _
                    "'hanako' as NAME, " & _
                    "'日本' as CONTRY " & _
                "from dummy " & _
                "union all " & _
                "select " & _
                    "9 as ID, " & _
                    "'tom' as NAME, " & _
                    "'アメリカ' as CONTRY " & _
                "from dummy " & _
            "]. as Qtmp"                          
        
    strSQL2 = "select * from テーブル1 order by ID"
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = constr
    cn.Open
    
    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = cn
        
        .CommandText = strSQL1
        .Execute rcnt
                
        .CommandText = strSQL2
        Set rs = .Execute
    End With
            
    MsgBox rcnt & " レコードを追加しました"
            
    With Worksheets("Sheet1")
        .Cells.Clear
            rs.MoveFirst
        i = 1
        .Cells.Clear
        Do Until rs.EOF
            For j = 0 To rs.Fields.Count - 1
                If i = 1 Then .Cells(i, j + 1) = rs(j).Name
                .Cells(i + 1, j + 1) = rs(j).Value
            Next j
            rs.MoveNext
            i = i + 1
        Loop
        .Columns("A:H").AutoFit
    End With
        
    Set cmd = Nothing
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

End Sub

Sub Sample_Command_ExecuteInsert2()

'参照設定:Microsoft ActiveX Data Objects 6.1 Library

Dim cn As ADODB.Connection

Dim cmd As ADODB.Command

Dim rs As ADODB.Recordset

Dim constr As String

Dim DBFile As String

Dim i As Long

Dim j As Long

Dim strSQL1 As String

Dim strSQL2 As String

Dim rcnt As Long

DBFile = ActiveWorkbook.Path & "\mydb1.accdb"

constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile

strSQL1 = "insert into テーブル1(ID, NAME, CONTRY) " & _

"select * from " & _

"[ " & _

"select " & _

"8 as ID, " & _

"'hanako' as NAME, " & _

"'日本' as CONTRY " & _

"from dummy " & _

"union all " & _

"select " & _

"9 as ID, " & _

"'tom' as NAME, " & _

"'アメリカ' as CONTRY " & _

"from dummy " & _

"]. as Qtmp"

strSQL2 = "select * from テーブル1 order by ID"

Set cn = New ADODB.Connection

cn.ConnectionString = constr

cn.Open

Set cmd = New ADODB.Command

With cmd

.ActiveConnection = cn

.CommandText = strSQL1

.Execute rcnt

.CommandText = strSQL2

Set rs = .Execute

End With

MsgBox rcnt & " レコードを追加しました"

With Worksheets("Sheet1")

.Cells.Clear

rs.MoveFirst

i = 1

.Cells.Clear

Do Until rs.EOF

For j = 0 To rs.Fields.Count - 1

If i = 1 Then .Cells(i, j + 1) = rs(j).Name

.Cells(i + 1, j + 1) = rs(j).Value

Next j

rs.MoveNext

i = i + 1

Loop

.Columns("A:H").AutoFit

End With

Set cmd = Nothing

Set rs = Nothing

cn.Close

Set cn = Nothing

End Sub

strSQL1 について（20行目～34行目）
20行目：INSERT INTO [テーブル名] ( [列名1], [列名2], ・・・ )
23行目：１つ目の追加するレコード（～27行目）
24行目：8 as ID,　→　[データ] as [列名]
25行目：’hanako’ as NAME,　→　[データ] as [列名]
26行目：’日本’ as CONTRY　→　[データ] as [列名]
29行目：２つ目の追加するレコード（～33行目）
（※　１つ目のレコードと２つ目のレコードのフィールドは揃える必要があります。）
34行目：”]. as Qtmp”　→　「.」は必要です。「Qtmp」任意の名前を指定します。

実行結果

UPDATE ステートメント（レコード変更）を実行する

【書式】

UPDATE target SET newvalue WHERE criteria

引数・戻り値

target ・・・変更するレコードのテーブル・クエリの名前を指定します。
newvalue ・・・変更するレコードのフィールド名（列名）、値を表すための式を指定します。
criteria ・・・対象となるレコードの抽出条件を指定します。ここで指定された条件を満たすレコードのみが変更されます。

サンプルVBAソース（レコードの更新）

　
Sub Sample_Command_ExecuteUpdate()

    '参照設定:Microsoft ActiveX Data Objects 6.1 Library
    
    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim constr As String
    Dim DBFile As String
    Dim i As Long
    Dim j As Long
    Dim strSQL1 As String
    Dim strSQL2 As String
    Dim rcnt 'RecordsAffected
    
    DBFile = ActiveWorkbook.Path & "\mydb1.accdb"
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile
    
    strSQL1 = "update テーブル4 " & _
             "set 部署C = 106 where 部署C = 200"

    strSQL2 = "select * from テーブル4 order by 社員ID"
    
    Set cn = New ADODB.Connectionpp
    cn.ConnectionString = constr
    cn.Open
    
    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = cn
        
        .CommandText = strSQL1
        .Execute rcnt
        
        .CommandText = strSQL2
        Set rs = .Execute
    End With
    
    MsgBox rcnt & " のデータを更新しました"
            
    With Worksheets("Sheet1")
        .Cells.Clear
            rs.MoveFirst
        i = 1
        .Cells.Clear
        Do Until rs.EOF
            For j = 0 To rs.Fields.Count - 1
                If i = 1 Then .Cells(i, j + 1) = rs(j).Name
                .Cells(i + 1, j + 1) = rs(j).Value
            Next j
            rs.MoveNext
            i = i + 1
        Loop
        .Columns("A:H").AutoFit
    End With
        
    Set cmd = Nothing
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

End Sub

Sub Sample_Command_ExecuteUpdate()

'参照設定:Microsoft ActiveX Data Objects 6.1 Library

Dim cn As ADODB.Connection

Dim cmd As ADODB.Command

Dim rs As ADODB.Recordset

Dim constr As String

Dim DBFile As String

Dim i As Long

Dim j As Long

Dim strSQL1 As String

Dim strSQL2 As String

Dim rcnt 'RecordsAffected

DBFile = ActiveWorkbook.Path & "\mydb1.accdb"

constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile

strSQL1 = "update テーブル4 " & _

"set 部署C = 106 where 部署C = 200"

strSQL2 = "select * from テーブル4 order by 社員ID"

Set cn = New ADODB.Connectionpp

cn.ConnectionString = constr

cn.Open

Set cmd = New ADODB.Command

With cmd

.ActiveConnection = cn

.CommandText = strSQL1

.Execute rcnt

.CommandText = strSQL2

Set rs = .Execute

End With

MsgBox rcnt & " のデータを更新しました"

With Worksheets("Sheet1")

.Cells.Clear

rs.MoveFirst

i = 1

.Cells.Clear

Do Until rs.EOF

For j = 0 To rs.Fields.Count - 1

If i = 1 Then .Cells(i, j + 1) = rs(j).Name

.Cells(i + 1, j + 1) = rs(j).Value

Next j

rs.MoveNext

i = i + 1

Loop

.Columns("A:H").AutoFit

End With

Set cmd = Nothing

Set rs = Nothing

cn.Close

Set cn = Nothing

End Sub

実行結果

DELETE ステートメント（レコード削除）を実行する

【書式】

DELETE FROM table WHERE criteria

引数・戻り値

table ・・・削除するレコードのあるテーブル名を指定します。
criteria ・・・対象となるレコードの抽出条件を指定します。ここで指定された条件を満たすレコードのみが削除されます。

サンプルVBAソース（レコードの削除）

　
Sub Sample_Command_ExecuteDelete()

    '参照設定:Microsoft ActiveX Data Objects 6.1 Library
    
    Dim cn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim constr As String
    Dim DBFile As String
    Dim i As Long
    Dim j As Long
    Dim strSQL As String
    Dim strSQL2 As String
    Dim rcnt As Long
    
    DBFile = ActiveWorkbook.Path & "\mydb1.accdb"
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile
    strSQL = "delete from テーブル4 " & _
             "where 社員ID in('H0051','H0055')"
    strSQL2 = "select * from テーブル4 order by 社員ID"
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = constr
    cn.Open
    
    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = cn
        .CommandText = strSQL
        .Execute RecordsAffected:=rcnt
        .CommandText = strSQL2
        Set rs = .Execute
    End With
    
    MsgBox rcnt & " のデータを削除しました。"
        
    With Worksheets("Sheet1")
        .Cells.Clear
            rs.MoveFirst
        i = 1
        .Cells.Clear
        Do Until rs.EOF
            For j = 0 To rs.Fields.Count - 1
                If i = 1 Then .Cells(i, j + 1) = rs(j).Name
                .Cells(i + 1, j + 1) = rs(j).Value
            Next j
            rs.MoveNext
            i = i + 1
        Loop
        .Columns("A:H").AutoFit
    End With
        
    Set cmd = Nothing
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

End Sub

Sub Sample_Command_ExecuteDelete()

'参照設定:Microsoft ActiveX Data Objects 6.1 Library

Dim cn As ADODB.Connection

Dim cmd As ADODB.Command

Dim rs As ADODB.Recordset

Dim constr As String

Dim DBFile As String

Dim i As Long

Dim j As Long

Dim strSQL As String

Dim strSQL2 As String

Dim rcnt As Long

DBFile = ActiveWorkbook.Path & "\mydb1.accdb"

constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile

strSQL = "delete from テーブル4 " & _

"where 社員ID in('H0051','H0055')"

strSQL2 = "select * from テーブル4 order by 社員ID"

Set cn = New ADODB.Connection

cn.ConnectionString = constr

cn.Open

Set cmd = New ADODB.Command

With cmd

.ActiveConnection = cn

.CommandText = strSQL

.Execute RecordsAffected:=rcnt

.CommandText = strSQL2

Set rs = .Execute

End With

MsgBox rcnt & " のデータを削除しました。"

With Worksheets("Sheet1")

.Cells.Clear

rs.MoveFirst

i = 1

.Cells.Clear

Do Until rs.EOF

For j = 0 To rs.Fields.Count - 1

If i = 1 Then .Cells(i, j + 1) = rs(j).Name

.Cells(i + 1, j + 1) = rs(j).Value

Next j

rs.MoveNext

i = i + 1

Loop

.Columns("A:H").AutoFit

End With

Set cmd = Nothing

Set rs = Nothing

cn.Close

Set cn = Nothing

End Sub

実行結果

Connection オブジェクトの Execute メソッドで、SQL文を実行

Connection オブジェクトで Execute メソッドを使用すると、CommandText プロパティに指定したSQL文やクエリ等が実行されます。CommandText プロパティに結果を返す SQL文やクエリ等が指定された場合、新規の Recordset オブジェクトに保存されます。

Connection.Execute メソッド

【書式】

＜取得＞
Set recordset = object.Execute [ ( CommandText, RecordsAffected, Options ) ]

object.Execute [ CommandText, RecordsAffected, Options ]

引数・戻り値

object ・・・対象となる Connection オブジェクトを指定します。
recordset ・・・ Recordset オブジェクトを表すオブジェクト変数です。Execute メソッドの実行結果、または、Nothing を取得します。
CommandText ・・・実行する SQL文を指定します。
RecordsAffected ・・・長整数型（Long）の変数を指定します。Execute メソッド実行操作によって影響を受けたレコードの数をこの変数に返します（つまり、更新クエリ・追加クエリ・削除クエリなどで変更のあったレコードの数、省略可）。
Options ・・・ CommandText プロパティの評価を最適化するために使います。省略すると adCmdUnknown が指定されたと見なされます。

サンプルVBAソース（Select文の実行）

　
Sub Sample_Connection_ExecuteSQL()

    '参照設定:Microsoft ActiveX Data Objects 6.1 Library
    
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim constr As String
    Dim DBFile As String
    Dim strSQL As String
    Dim i As Long
    Dim j As Long
    
    DBFile = ActiveWorkbook.Path & "\mydb1.accdb"
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile
    strSQL = "select * from テーブル4 where 性別='男' and 部署C=106"
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = constr
    cn.Open
    
    Set rs = cn.Execute(strSQL)
    
    With Worksheets("Sheet1")
        .Cells.Clear
        i = 1
        .Cells.Clear
        Do Until rs.EOF
            For j = 0 To rs.Fields.Count - 1
                If i = 1 Then .Cells(i, j + 1) = rs(j).Name
                .Cells(i + 1, j + 1) = rs(j).Value
            Next j
            rs.MoveNext
            i = i + 1
        Loop
        .Columns("A:H").AutoFit
    End With
    
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

End Sub

Sub Sample_Connection_ExecuteSQL()

'参照設定:Microsoft ActiveX Data Objects 6.1 Library

Dim cn As ADODB.Connection

Dim rs As ADODB.Recordset

Dim constr As String

Dim DBFile As String

Dim strSQL As String

Dim i As Long

Dim j As Long

DBFile = ActiveWorkbook.Path & "\mydb1.accdb"

constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile

strSQL = "select * from テーブル4 where 性別='男' and 部署C=106"

Set cn = New ADODB.Connection

cn.ConnectionString = constr

cn.Open

Set rs = cn.Execute(strSQL)

With Worksheets("Sheet1")

.Cells.Clear

i = 1

.Cells.Clear

Do Until rs.EOF

For j = 0 To rs.Fields.Count - 1

If i = 1 Then .Cells(i, j + 1) = rs(j).Name

.Cells(i + 1, j + 1) = rs(j).Value

Next j

rs.MoveNext

i = i + 1

Loop

.Columns("A:H").AutoFit

End With

Set rs = Nothing

cn.Close

Set cn = Nothing

End Sub

実行結果

サンプルVBAソース（Insert Into文の実行）

　
Sub Sample_Connection_ExecuteInsert()

    '参照設定:Microsoft ActiveX Data Objects 6.1 Library
    
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim constr As String
    Dim DBFile As String
    Dim i As Long
    Dim j As Long
    Dim strSQL1 As String
    Dim strSQL2 As String
                    
    DBFile = ActiveWorkbook.Path & "\mydb1.accdb"
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile
    
    strSQL1 = "insert into " & _
              "テーブル4 (社員ID,氏名,フリガナ,性別,部署C,入社年月日) " & _
              "values ('H0053','笹原やよい','ササハラヤヨイ','女',100,#1999/12/10#)"

    strSQL2 = "select * from テーブル4 where 社員ID like 'H005%'"
    
    Set cn = New ADODB.Connection
    
    With cn
    
        .ConnectionString = constr
        .Open
        
        .Execute strSQL1
        Set rs = .Execute(strSQL2)
    
    End With
            
    With Worksheets("Sheet1")
        .Cells.Clear
            rs.MoveFirst
        i = 1
        .Cells.Clear
        Do Until rs.EOF
            For j = 0 To rs.Fields.Count - 1
                If i = 1 Then .Cells(i, j + 1) = rs(j).Name
                .Cells(i + 1, j + 1) = rs(j).Value
            Next j
            rs.MoveNext
            i = i + 1
        Loop
        .Columns("A:H").AutoFit
    End With
        
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

End Sub

Sub Sample_Connection_ExecuteInsert()

'参照設定:Microsoft ActiveX Data Objects 6.1 Library

Dim cn As ADODB.Connection

Dim rs As ADODB.Recordset

Dim constr As String

Dim DBFile As String

Dim i As Long

Dim j As Long

Dim strSQL1 As String

Dim strSQL2 As String

DBFile = ActiveWorkbook.Path & "\mydb1.accdb"

constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile

strSQL1 = "insert into " & _

"テーブル4 (社員ID,氏名,フリガナ,性別,部署C,入社年月日) " & _

"values ('H0053','笹原やよい','ササハラヤヨイ','女',100,#1999/12/10#)"

strSQL2 = "select * from テーブル4 where 社員ID like 'H005%'"

Set cn = New ADODB.Connection

With cn

.ConnectionString = constr

.Open

.Execute strSQL1

Set rs = .Execute(strSQL2)

End With

With Worksheets("Sheet1")

.Cells.Clear

rs.MoveFirst

i = 1

.Cells.Clear

Do Until rs.EOF

For j = 0 To rs.Fields.Count - 1

If i = 1 Then .Cells(i, j + 1) = rs(j).Name

.Cells(i + 1, j + 1) = rs(j).Value

Next j

rs.MoveNext

i = i + 1

Loop

.Columns("A:H").AutoFit

End With

Set rs = Nothing

cn.Close

Set cn = Nothing

End Sub

実行結果

サンプルVBAソース（Delete文の実行）

　
Sub Sample_Connection_ExecuteDelete()

    '参照設定:Microsoft ActiveX Data Objects 6.1 Library
    
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim constr As String
    Dim DBFile As String
    Dim i As Long
    Dim j As Long
    Dim strSQL1 As String
    Dim strSQL2 As String
    Dim rcnt As Long
    
    DBFile = ActiveWorkbook.Path & "\mydb1.accdb"
    constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile
    strSQL1 = "delete from テーブル4 " & _
             "where 氏名 like '笹原%'"
    strSQL2 = "select * from テーブル4 where 社員ID like 'H005%' order by 社員ID"
    
    Set cn = New ADODB.Connection
    
    With cn
        .ConnectionString = constr
        .Open
        
        .Execute strSQL1, rcnt
        Set rs = .Execute(strSQL2)
    End With
        
    MsgBox rcnt & " 個のレコードを削除しました。"
        
    With Worksheets("Sheet1")
        .Cells.Clear
        i = 1
        .Cells.Clear
        Do Until rs.EOF
            For j = 0 To rs.Fields.Count - 1
                If i = 1 Then .Cells(i, j + 1) = rs(j).Name
                .Cells(i + 1, j + 1) = rs(j).Value
            Next j
            rs.MoveNext
            i = i + 1
        Loop
        .Columns("A:H").AutoFit
    End With
        
    Set rs = Nothing
    cn.Close
    Set cn = Nothing

End Sub

Sub Sample_Connection_ExecuteDelete()

'参照設定:Microsoft ActiveX Data Objects 6.1 Library

Dim cn As ADODB.Connection

Dim rs As ADODB.Recordset

Dim constr As String

Dim DBFile As String

Dim i As Long

Dim j As Long

Dim strSQL1 As String

Dim strSQL2 As String

Dim rcnt As Long

DBFile = ActiveWorkbook.Path & "\mydb1.accdb"

constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBFile

strSQL1 = "delete from テーブル4 " & _

"where 氏名 like '笹原%'"

strSQL2 = "select * from テーブル4 where 社員ID like 'H005%' order by 社員ID"

Set cn = New ADODB.Connection

With cn

.ConnectionString = constr

.Open

.Execute strSQL1, rcnt

Set rs = .Execute(strSQL2)

End With

MsgBox rcnt & " 個のレコードを削除しました。"

With Worksheets("Sheet1")

.Cells.Clear

i = 1

.Cells.Clear

Do Until rs.EOF

For j = 0 To rs.Fields.Count - 1

If i = 1 Then .Cells(i, j + 1) = rs(j).Name

.Cells(i + 1, j + 1) = rs(j).Value

Next j

rs.MoveNext

i = i + 1

Loop

.Columns("A:H").AutoFit

End With

Set rs = Nothing

cn.Close

Set cn = Nothing

End Sub