access数据存档-将记录移到另一个数据库中

在不需要的旧数据情况下，例如数十万条记录，并且不断添加新记录。我们会把旧的不需要数据单独的保存在另外的数据库中。

执行过程包括以下步骤：
1. 开始一个事务。
2. 执行追加查询。
3. 执行delete查询。
4. 获取用户确认以提交更改。
5. 如果任何步骤出现错误，则回滚事务。


详细代码：

Sub DoArchive()
    On Error GoTo Err_DoArchive
    Dim ws As DAO.Workspace   'Current workspace (for transaction).
    Dim db As DAO.Database    'Inside the transaction.
    Dim bInTrans As Boolean   'Flag that transaction is active.
    Dim strSql As String      'Action query statements.
    Dim strMsg As String      'MsgBox message.
    
'    Step 1: Initialize database object inside a transaction.
    Set ws = DBEngine(0)
    ws.BeginTrans
    bInTrans = True
    Set db = ws(0)
    
'    Step 2: Execute the append.
    strSql = "INSERT INTO  MyTable(Field1, Field2, Field3 ) " & "IN ""C:\MyData.accdb"" " & "SELECT  到货日期, 采购编码, 到达数量 FROM tblPurchaseDetail WHERE (MyYesNoField = True) "
    db.Execute strSql, dbFailOnError
    
'    Step 3: Execute the delete.
    strSql = "DELETE FROM tblPurchaseDetail WHERE (MyYesNoField = True)"
    db.Execute strSql, dbFailOnError
    
'    Step 4: Get user confirmation to commit the change.
    strMsg = "Archive " & db.RecordsAffected & " record(s)?"
    If MsgBox(strMsg, vbOKCancel + vbQuestion, "Confirm") = vbOK Then
        ws.CommitTrans
        bInTrans = False
    End If
    
Exit_DoArchive:
'    Step 5: Clean up
    On Error Resume Next
    Set db = Nothing
    If bInTrans Then   'Rollback if the transaction is active.
        ws.Rollback
    End If
    Set ws = Nothing
    Exit Sub
    
Err_DoArchive:
    MsgBox Err.Description, vbExclamation, "Archiving failed: Error " & Err.Number
    Resume Exit_DoArchive
End Sub

把数据库的旧数据添加到C:\Mydata数据库中