[求助]ACCESS的事务处理

XIAJIANJUN

我在ACCESS中作了个按钮，就下面两条指令：

    CurrentProject.Connection.BeginTrans
    CurrentProject.Connection.CommitTrans

总是出现“试着不先使用BeginTrans而提交或退回事务”

有没有谁知道原因？先谢了。

marine12

access也支持事务吗?

fan0217

请使用ADO的事物处理。

Public Sub Main()
    On Error GoTo ErrorHandler

    Dim Cnxn As ADODB.Connection
    Dim strCnxn As String
    Dim rstTitles As ADODB.Recordset
    Dim strSQLTitles As String
    Dim strTitle As String
    Dim strMessage As String
   
    strCnxn = "rovider='sqloledb';Data Source='MySqlServer';" & _
        "Initial Catalog='Pubs';Integrated Security='SSPI';"
    Set Cnxn = New ADODB.Connection
    Cnxn.Open strCnxn
   
    Set rstTitles = New ADODB.Recordset
    strSQLTitles = "Titles"
    rstTitles.Open strSQLTitles, Cnxn, adOpenDynamic, adLockPessimistic, adCmdTable
   
    Cnxn.BeginTrans
   
    rstTitles.MoveFirst
   
    Do Until rstTitles.EOF
        If Trim(rstTitles!Type) = "psychology" Then
            strTitle = rstTitles!Title
            strMessage = "Title: " & strTitle & vbCr & _
            "Change type to self help?"

            ' If yes, change type for the specified title
            If MsgBox(strMessage, vbYesNo) = vbYes Then
                rstTitles!Type = "self_help"
                rstTitles.Update
            End If
        End If
    rstTitles.MoveNext
    Loop

    If MsgBox("Save all changes?", vbYesNo) = vbYes Then
        Cnxn.CommitTrans
    Else
        Cnxn.RollbackTrans
    End If

    rstTitles.Requery
    rstTitles.MoveFirst
    Do While Not rstTitles.EOF
        Debug.Print rstTitles!Title & " - " & rstTitles!Type
        rstTitles.MoveNext
    Loop

    rstTitles.MoveFirst
   
    Do Until rstTitles.EOF
        If Trim(rstTitles!Type) = "self_help" Then
            rstTitles!Type = "psychology"
            rstTitles.Update
        End If
        rstTitles.MoveNext
    Loop
   
    rstTitles.Close
    Cnxn.Close
    Set rstTitles = Nothing
    Set Cnxn = Nothing
    Exit Sub
   
ErrorHandler:
    If Not rstTitles Is Nothing Then
        If rstTitles.State = adStateOpen Then rstTitles.Close
    End If
    Set rstTitles = Nothing
   
    If Not Cnxn Is Nothing Then
        If Cnxn.State = adStateOpen Then Cnxn.Close
    End If
    Set Cnxn = Nothing
   
    If Err <> 0 Then
        MsgBox Err.Source & "-->" & Err.Description, , "Error"
    End If
End Sub

[此贴子已经被作者于2006-11-23 19:15:47编辑过]