【EXCEL_VBA】DBのデータを他のDBにコピーする

DBのメンテナンス

DB内部のデータを削除しDBのスペース確保します。 削除する前にBACKUP用DBにコピーします。

EXCEL＿VBAの内容

・DBの変数定義

・DBと接続

・DBをOPEN＆データCOPY

・DBのデータ削除

Dim cn1 As ADODB.Connection
Dim rs1 As New ADODB.Recordset
Dim cmd1 As New ADODB.Command
Dim FileName1 As String
Dim DB1 As DAO.Database

Dim cn2 As ADODB.Connection
Dim rs2 As New ADODB.Recordset
Dim cmd2 As New ADODB.Command
Dim FileName2 As String
Dim DB2 As DAO.Database

Set cn1 = New ADODB.Connection
FileName1 = "\\192.168.1.99\ABC\db\XDB.mdb"
cn1.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & FileName1

Set cn2 = New ADODB.Connection
FileName2 = "\\192.168.1.99\ABC\db\XDB(BACKUP).mdb"
cn2.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & FileName2

Set cn3 = New ADODB.Connection
FileName3 = "\\192.168.1.99\ABC\db\ XDB.mdb"
cn3.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & FileName3
‘―――――――――――――――――――――――――――――――――
‘DBから商品＝商品のデータを検索(SELECT)しバックアップDBに追加　　　
‘―――――――――――――――――――――――――――――――――
　　　INSERT  INTO  テーブル名　　IN  バックアップDB(書き込む先)　select * FROM　読み込むテーブル名　WHERE　商品＝商品で検索　
work_s = " insert into data " & "IN '\\192.168.1.99\ABC\db\XDB(BACKUP).mdb' select * FROM data  WHERE 商品='" & 商品 & "'"
 work_s = work_s & " ;"
 work_cpy = work_s
Err.Number = 0
 With cmd1
    .Ac tiveConnection = cn1
    .CommandText = work_cpy
    Set rs1 = .Execute
 End With
 MsgBox " err.number =" & Err.Number
 If Err.Number = 0 Then
    '--------------------------------------------------------------------------
    ' データをバックアップDBにコピーできたら 削除
    '--------------------------------------------------------------------------
    work_s = " DELETE * FROM data  WHERE 商品='" & 商品 & "'"
    work_s = work_s & " ;"
    work_del = work_s
    Err.Number = 0
    With cmd1
      .ActiveConnection = cn1
      .CommandText = work_del
      Set rs1 = .Execute
    End With
MsgBox " err.number =" & Err.Number
　  If Err.Number = 0 Then
    
　  Else
     MsgBox "【XDB.mdb】 " & 商品 & " 削除失敗"
    End If
    '-----------------------------
 Else
    MsgBox "【XDB(BACKUP).mdb】 " & 商品 & " " &  " Err.number=" & Err.Number
 End If