office交流網--QQ交流群號

Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

access數據存檔-將記録移到另一箇數據庫中

2019-10-16 16:22:00
Allen Browne
轉貼
2879
在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數據庫中


    分享