Sub Connection()
Dim con As New ADODB.Connection
Dim strQ As String

On Error GoTo ErrorHandler
con.ConnectionString = "Provider=SQLNCLI10.1;Server=SRV-SQL;Database=MyDB;Trusted_Connection=yes;"
con.Open
con.BeginTrans

  strQ = "delete from MyTABLE where ID = 1 " 
  strQ = strQ + "insert into MyTABLE VALUES (1,1)"     
  'второй insert должен вернуть ошибку
  strQ = "delete from MyTABLE where ID = 2 "
  strQ = strQ + "insert into MyTABLE VALUES (2,'FAIL')"     

 con.Execute strQ, adCmdText
con.CommitTrans
con.Close
Set con = Nothing

Exit Sub
 
ErrorHandler:
 Debug.Print "Err: " & Err.Source & "-->" & Err.Description & "-->" & Err.Number
 con.RollbackTrans
    If Not con Is Nothing Then
        If con.State = adStateOpen Then con.Close
    End If
    Set con = Nothing 
End Sub

  strQ = strQ + "insert into MyTABLE VALUES (2,'FAIL')"     

     
Dim rAffected As Long

 strQ = "delete from MyTABLE where ID = 2 "
 strQ = strQ + "insert into MyTABLE VALUES (2,'FAIL')"     

con.Execute strQ, rAffected, adCmdText

    Debug.Print "con.State: " & con.State
    Debug.Print "Err.Count: " & con.Errors.Count
    Debug.Print "rows Affected: " & rAffected & vbCrLf      
     
For Each E In con.Errors
     Debug.Print "Error.Description: " & E.Description
      Debug.Print "Error.Number: " & E.Number
      Debug.Print "Error.Source: " & E.Source
      Debug.Print "Error.SQLState: " & E.SqlState
      Debug.Print "Error.NativeError: " & E.NativeError
Next

strQ = strQ + "insert into MyTABLE VALUES (2,'FAIL')"     
con.Execute strQ, rAffected, adCmdText