請教各位大蝦：VB中的事务處理？

A語句執行失敗没有错误信息。
吾把A語句、C語句放到MS SQL的“Query Analyzer”中執行時，都成功了。

真搞不懂了!!!能不能共享点代码Look Look...

要用 On error goto err1
来捕获可能发生的错误,发生任何错误,都应跳转并执行回滚
如果不这样,事务就没有任何意义

On Error GoTo lErr

    gCnnMain.BeginTrans

    Dim strFormNo As String '表單編號
    Dim strSql As String

    '獲取表單編號
    If Trim(txtCode.Text) <> "" Then
        strFormNo = Trim(txtCode.Text)
    Else
        strFormNo = gGetNewDocumentID(dOrderCode)
    End If
    If strFormNo = "" Then
        MsgBox gGetResString("36061", 1, "未找到銷售發票編號！") & vbCrLf & vbCrLf & _
            gGetResString("36062", 1, "請在""系統維護""->""帳套設置""中添加銷售發票編　　　　　　　　　碼。"), vbExclamation, sApplicationTitle
        gCnnMain.RollbackTrans
        Exit Function
    End If

    '主表
    strSql = "insert into s_invoice_hd(" & _
        "inv_no,p_inv_no,increase_inv_no,increase_inv_amt,cust_no,si_date,due_date,cy_id,exch_rate," & _
        "deposit,sales_amt,master_amt,tot_disc,empl_no,inv_type,icld_tax,tax_rate,creator,re,posted," & _
        "discount,disc_amt,cr_conditions) values(" & _
        "'" & UCase(gTransCharForSql(strFormNo)) & "'," & "'" & UCase(gTransCharForSql(StockinVoiceNo)) & "'," & _
        "'" & UCase(gTransCharForSql(Trim(txtIncInvNo.Text))) & "'," & _
        "" & TransStringToDouble(txtIncInvAmt.Text) & "," & _
        "'" & UCase(gTransCharForSql(Trim(txtVendCode.Text))) & "'," & _
        "'" & Format(dtpDate.Value, "yyyy/MM/dd") & "'," & _
        "'" & Format(dtpDueDate.Value, "yyyy/MM/dd") & "'," & _
        "'" & UCase(gTransCharForSql(Trim(lblCyId.Caption))) & "'," & _
        "" & IIf(Trim(lblExchRate.Caption) = "", 0, lblExchRate.Caption) & "," & _
        "" & TransStringToDouble(txtDeposit.Text) & "," & _
        "" & mDblAmt & "," & _
        "" & mDblMasterAmt & "," & _
        "" & TransStringToDouble(lblDiscAmt.Caption) & "," & _
        "'" & gTransCharForSql(Trim(lstBuyer.Text)) & "'," & _
        "" & cboInvType.ListIndex & "," & chkTax.Value & "," & _
        "" & TransStringToDouble(txtTaxRate.Text) & "," & _
        "'" & gStrUserID & "'," & _
        "'" & gTransCharForSql(Trim(txtRe.Text)) & "'," & _
        "0," & _
        "" & TransStringToDouble(txtDiscount.Text) & "," & _
        "" & TransStringToDouble(txtDiscAmt.Text) & "," & _
        "'" & gTransCharForSql(Trim(cboCrTerm.Text)) & "')"
    Call gExecuteSql(gCnnMain, strSql, True, mlogContent, , sModuleName, mBytEditMode)

    If GetLockSR(True, False, strFormNo, True) Then
        '鎖記錄成功
    Else
        MsgBox "對不起，成本核算表被人鎖定，請再試一次。", vbExclamation, 　　sApplicationTitle
        gCnnMain.RollbackTrans
        Exit Function
    End If

    '明細
    strSql = GetAddDetailSql(strFormNo)
    Call gExecuteSql(gCnnMain, strSql, True, mlogContent, , sModuleName, mBytEditMode)

    '解鎖
    Call GetLockSR(False, False, "", False)

    txtCode.Text = strFormNo
    gCnnMain.CommitTrans
    AddNewForm = True

    '檢測是否保存成功，不成功則寫入日誌
    Dim strsql1 As String
    Dim rsttemp As ADODB.Recordset
    strsql1 = "select a.inv_no from s_invoice_hd a inner join s_invoice_dt b  on a.inv_no=b.inv_no " & _
            " Where b.inv_no= '" & strFormNo & "'"
    Set rsttemp = gCnnMain.Execute(strsql1)
    If rsttemp.RecordCount = 0 Then
        'Call gWriteLogToDb(gCnnMain, strSQL, gStrUserID, sModuleName, "C031", 0)
        Call gInfomationHandler(sModuleName & ".讀取數據失敗，單號：" & strFormNo & "Datetime:" & str(Date) & str(Time) & ",Creator:" & gStrUserID, True)
    End If
    Set rsttemp = Nothing

    Exit Function

lErr:

    gCnnMain.RollbackTrans
    Call gErrorHandler(sModuleName & ".AddNewForm", True)

主表保存不成功，
明細表保存成功。
中間過程　GetLockSR　的代碼：'****************************************************************
'函數名: GetLockSR
'說  明: 鎖定或解鎖 Stock_Records 表中的對應記錄。
'輸  入: blnLock  鎖定與否。  True  鎖定； False  解鎖
'        blnDel   是否刪除。  True  刪除； False  新增
'返回值: Boolean
'創  建:
'修  改:
'****************************************************************
Private Function GetLockSR(ByVal blnLock As Boolean, Optional ByVal blnDel As Boolean = False, Optional ByVal Inv_no As String = "", Optional ByVal blnEmpty As Boolean = True) As Boolean

    On Error GoTo lErr

    Dim strSql As String
    Dim str1 As String
    Dim rst As ADODB.Recordset

    GetLockSR = False

    strSql = ""
    If blnDel Then
        If blnEmpty Then mStrUnlock = ""
        '
        If blnLock Then
            Dim rst1 As ADODB.Recordset

            str1 = "select part_no,ware_no from s_invoice_dt where inv_no  ='" & Inv_no & "' group by part_no,ware_no"
            '
            Set rst1 = gCnnMain.Execute(str1)
            Do While Not rst1.EOF
                str1 = "select top 1 flag,s_id from stock_records where part_no='" & _
                    Trim(rst1!Part_no & "") & "' and ware_no='" & Trim(rst1!Ware_no & "") & "' order by s_id asc"
                Set rst = gCnnMain.Execute(str1)
                If rst.EOF Then
                    GetLockSR = True
                Else
                    If Val(rst!flag & "") = 2 Then
                        'MsgBox "對不起，你現在不能更新。成本核算不成功，請等待片刻... ...", vbExclamation, sApplicationTitle
                        GetLockSR = False
                        GoTo LExit
                    Else
                        mStrUnlock = mStrUnlock & vbCrLf & "update stock_records set flag=1 where flag=2 and s_id='" & Trim(rst!s_id & "") & "'"
                        strSql = strSql & vbCrLf & "update stock_records set flag=2 where s_id='" & Trim(rst!s_id & "") & "'"
                    End If
                End If
                rst1.MoveNext
            Loop
        Else
            strSql = mStrUnlock
        End If
    Else
        If blnEmpty Then mStrUnlock = ""
        '
        If blnLock Then
            If mRstDtl.RecordCount > 0 Then mRstDtl.MoveFirst
            Do Until mRstDtl.EOF
                str1 = "select top 1 flag,s_id from stock_records where part_no='" & _
                    Trim(mRstDtl!Part_no & "") & "' and ware_no='" & Trim(mRstDtl!Ware_no & "") & "'  order by s_id asc"
                Set rst = gCnnMain.Execute(str1)
                If rst.EOF Then
                    GetLockSR = True
                Else
                    If Val(rst!flag & "") = 2 Then
                        'MsgBox "對不起，你現在不能更新。成本核算不成功，請等待片刻... ...", vbExclamation, sApplicationTitle
                        GetLockSR = False
                        GoTo LExit
                    Else
                        strSql = strSql & vbCrLf & "update stock_records set flag=2 where s_id='" & Trim(rst!s_id & "") & "'"
                        mStrUnlock = mStrUnlock & vbCrLf & "update stock_records set flag=1 where flag=2 and s_id='" & Trim(rst!s_id & "") & "'"
                    End If
                End If
                mRstDtl.MoveNext
            Loop
        Else
            strSql = mStrUnlock
        End If
    End If
    '
    If Trim(strSql) <> "" Then
        gCnnMain.Execute strSql
        GetLockSR = True
    End If
    '
    GoTo LExit

lLoop:
    Dim i As Integer
    Me.MousePointer = 11
    For i = 0 To 10000
        strSql = ""
    Next
    GetLockSR blnLock, blnDel, Inv_no, blnEmpty
    Me.MousePointer = 0

LExit:
    Set rst = Nothing
    Set rst1 = Nothing
    Exit Function

lErr:    If UCase(Trim(err.Description)) = "TRIGGER ROLLBACK" Then
        GoTo lLoop
    Else
        Call gErrorHandler(sModuleName & ".GetLockSR", True)
        GetLockSR = False
        GoTo LExit
    End If
End Function

GetLockSR　中沒有事務處理過程，
更沒有　ROLLBACK　動作。
求救！
Thanks!

'*************************************************************************
'**函数名：exsql
'**输    入： -
'**输    出：(Boolean) -执行是否成功
'**功能描述：执行sql语句
'**全局变量：
'**调用模块：
'**作    者：影子
'**日    期：2005-03-17 11:01:11
'**修改人：
'**日    期：
'**版    本：V1.0.0
'*************************************************************************
Public Function exsql(ParamArray sql()) As Boolean    '事务执行1个sql语句
    Dim cnConn As ADODB.Connection
    Set cnConn = New ADODB.Connection
    Dim Mysql
    On Error GoTo err1    cnConn.Open CN
    cnConn.BeginTrans '开始一个事务    For Each Mysql In sql
        cnConn.Execute Mysql
    Next
    cnConn.CommitTrans '提交一个事物    Set cnConn = Nothing
    exsql = TrueExit Functionerr1:
    cnConn.RollbackTrans '回滚一个事物
    exsql = False
End Function

zyg0(影子(如影随行) ：
　　先謝謝你！但我的　GetLockSR　中要對數據庫進行處理，與上面的情況不同。我想　是不是 GetLockSR　中的某些操作對事務的影響？
　　　或者　　根本就是事務有問題？？

ADO的事务不允许开始事务后进行和事务无关的操作，不要在事务中使用 Set rst = gCnnMain.Execute(str1) 的形式打开记录集
改用 dim rst as new adodb.recordset
rst.open "select * from",gcnnMain来打开，这样事务才能够知道你的操作要在事务中进行，如果你要执行SQl语句，请使用Command对象
来执行

调试易

請教各位大蝦：VB中的事务處理？

解决方案 »