一个SQL回滚示例

Option Compare Database
'本示例演示 ACCESS 中的 TRANSACTION 语句如何使用
'请将下列代码 COPY 到一个新建的“模块”中
'按 F5 查看运行效果

'本示例假定“表1”和“表2”在数据关系上有联系，
'在“表1”数据被删除后，必须在“表2”添加一行记录，
'如果添加记录不成功，则“表1”的数据不能被删除

Sub TransactionTest1()
'有错误代码时用ROLLBACK TRANSACTION回滚保证数据完整性
   
    '以下代码添加一些演示数据到 表1 中
    AddValues
   
    Dim strSQL As String
    strSQL = "delete from 表1"
    On Error Resume Next
    CurrentProject.Connection.Execute "begin TRANSACTION"
    CurrentProject.Connection.Execute strSQL
    '注意，由于“编号”字段是“自动编号”类型，不允许人为添加数据，
    '因此以下这句SQL语句会产生一个错误
    strSQL = "insert into 表2 (编号) values('2')"
    CurrentProject.Connection.Execute strSQL
    If Err <> 0 Then
        Debug.Print Err.Number & "->" & Err.Description
        CurrentProject.Connection.Execute "ROLLBACK TRANSACTION"
    Else
        CurrentProject.Connection.Execute "COMMIT TRANSACTION"
    End If
    Debug.Print "“表1”的记录数量为："; DCount("*", "表1") & _
                "。注意：“表1”的记录" & _
                IIf(DCount("*", "表1") = 0, "已经被删除", "未被删除")
End Sub

Sub TransactionTest2()
'没有错误代码时用COMMIT TRANSACTION结束任务
   
    '以下代码添加一些演示数据到 表1 中
    AddValues
   
    Dim strSQL As String
    strSQL = "delete from 表1"
    On Error Resume Next
    CurrentProject.Connection.Execute "begin TRANSACTION"
    CurrentProject.Connection.Execute strSQL
    '与 TransactionTest1 比较，本行SQL 代码是正确的。
    strSQL = "insert into 表2 ([LOG]) values('已经在" & Now() & "成功删除表1数据')"
    CurrentProject.Connection.Execute strSQL
    If Err <> 0 Then
        Debug.Print Err.Number & "->" & Err.Description
        CurrentProject.Connection.Execute "ROLLBACK TRANSACTION"
    Else
        CurrentProject.Connection.Execute "COMMIT TRANSACTION"
    End If
    Debug.Print "“表1”的记录数量为："; DCount("*", "表1") & _
                "。注意：“表1”的记录" & _
                IIf(DCount("*", "表1") = 0, "已经被删除", "未被删除")
End Sub

Sub TransactionTest3()
'没有事务处理机制的保证,数据完整性会被破坏

    '以下代码添加一些演示数据到 表1 中
    AddValues

    Dim strSQL As String
    strSQL = "delete from 表1"
    On Error Resume Next
    CurrentProject.Connection.Execute strSQL
    '注意，由于“编号”字段是“自动编号”类型，不允许人为添加数据，
    '因此以下这句SQL语句会产生一个错误
    strSQL = "insert into 表2 (编号) values('2')"
    CurrentProject.Connection.Execute strSQL
    If Err <> 0 Then
        Debug.Print Err.Number & "->" & Err.Description
    End If
    Debug.Print "“表1”的记录数量为："; DCount("*", "表1") & _
                "。注意：“表1”的记录" & _
                IIf(DCount("*", "表1") = 0, "已经被删除", "未被删除")

End Sub

'以下两个过程用于为演示做准备工作，如果你是在一个新的数据库中运行本示例，
'请先运行以下两个过程。

Sub CreateTable()
'以下代码在你的数据库中新建两个表，准备用于演示
    Dim strSQL As String
    strSQL = "create table 表1(编号 AUTOINCREMENT(1,1),start_date text(50)) "
    CurrentProject.Connection.Execute strSQL
    strSQL = "create table 表2(编号 AUTOINCREMENT(1,1),[log] text(50)) "
    CurrentProject.Connection.Execute strSQL
End Sub

Sub AddValues()
'以下代码添加一些演示数据到“表1”中
    Dim strSQL As String
    strSQL = "insert into 表1(start_date) values('aaa')"
    CurrentProject.Connection.Execute strSQL
    strSQL = "insert into 表1(start_date) values('bbb')"
    CurrentProject.Connection.Execute strSQL
    strSQL = "insert into 表1(start_date) values('ccc')"
    CurrentProject.Connection.Execute strSQL
    strSQL = "insert into 表1(start_date) values('ddd')"
    CurrentProject.Connection.Execute strSQL
    strSQL = "insert into 表1(start_date) values('eee')"
    CurrentProject.Connection.Execute strSQL
    strSQL = "insert into 表1(start_date) values('fff')"
    CurrentProject.Connection.Execute strSQL
   
End Sub