IF EXISTS(SELECT * FROM sysobjects WHERE xtype = 'U' AND name = 'MyTempTable')
	DROP TABLE MyTempTable
IF EXISTS(SELECT * FROM sysobjects WHERE xtype = 'U' AND name = 'MyTempTable1')
	DROP TABLE MyTempTable1

CREATE TABLE MyTempTable (Id Int PRIMARY KEY)
CREATE TABLE MyTempTable1 (Id Int PRIMARY KEY)
BEGIN TRAN
INSERT INTO MyTempTable(Id) VALUES ( 1 )
INSERT INTO MyTempTable(Id) VALUES ( 2 )

INSERT INTO MyTempTable1(Id) VALUES ( 1 )
 -- Здесь нарушается уникальность
 
INSERT INTO MyTempTable(Id) VALUES ( 1 )

COMMIT

Function TranTest()
On Error Resume Next
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim rst1 As ADODB.Recordset

    Set conn = CurrentProject.Connection
    conn.BeginTrans
    Set rst = New ADODB.Recordset
    rst.Open  "SELECT * FROM MyTempTable" , conn, adOpenKeyset, adLockOptimistic
    Set rst1 = New ADODB.Recordset
    rst1.Open  "SELECT * FROM MyTempTable1" , conn, adOpenKeyset, adLockOptimistic
    rst.AddNew
    rst!ID =  1 
    rst.AddNew
    rst!ID =  2 
    rst.Update
    
    rst1.AddNew
    rst1!ID =  1 
    rst1.AddNew
    rst1!ID =  1 
    ' Тут ошибка выходит
    rst1.Update
    
    conn.CommitTrans
    rst.Close
    rst1.Close
    
End Function