Access可以使用“事务”方式执行多个Sql语句的类模块

时　间:2022-03-05 20:15:16
作　者:AngelHis   ID：20576  城市：沈阳
摘　要:前几年自己写的类模块，目前使用还比较满意，拿出来和大家共享！
正　文:

’--------------------------------------------------

'使用方法：修改银行卡交易余额

         Dim C_ADO As New C_ADODB

                C_ADO.AddSql "Update T_BCARD_INFO set BCARD_COST = ROUND(BCARD_COST - " & BUSI_COST_OLD & ",2) " & _
                             "Where ID = " & BCARD_ID & ";"
                C_ADO.AddSql "Update T_BCARD_INFO set BCARD_COST = ROUND(BCARD_COST + " & BUSI_COST  & ",2) " & _
                             "Where ID = " & BCARD_ID & ";"
        If C_ADO.ExCol = 1 Then          MsgBox "交易信息保存成功！", vbInformation, "系统提示"

‘---------------------------------------------------------------------------------

Option Compare Database
Option Explicit
'------------创建一个类模块，命名为   C_ADODB
Public Conn As ADODB.Connection
Public sqlCol As Collection
'
Private Sub Class_Initialize()
    Set Conn = New ADODB.Connection
    Set sqlCol = New Collection
End Sub

Private Sub Class_Terminate()
    If Conn.State = 1 Then Conn.Close
    Set Conn = Nothing
    Set sqlCol = Nothing
End Sub

Public Function AddSql(ByVal StrSql As String)
    If Right(StrSql, 1) = ";" Then StrSql = Left(StrSql, Len(StrSql) - 1)
    sqlCol.Add StrSql
End Function

Public Function ExCol(Optional WARN As Integer, Optional iconn As ADODB.Connection, Optional notrs As Integer) As Integer
    Dim I As Long, j As Long   '注意：adodb不支持生成表查询，而且在客户端 Connection 对象上无效。
    Dim Conn As ADODB.Connection
    Dim FrmName As String
    If notrs = 0 Then
        On Error GoTo ExCol_Error
    Else
        On Error Resume Next
    End If
    If iconn Is Nothing Then
        Set Conn = CurrentProject.Connection    '默认打开服务器连接
    Else
        Set Conn = iconn    ' CurrentProject.Connection
    End If    '
    If sqlCol.Count = 0 or Conn.State = 0 Then Exit Function
    If notrs = 0 Then Conn.BeginTrans
    DoCmd.Hourglass True
    For I = 1 To sqlCol.Count
        err.Number = 0
        '       MsgBox sqlCol(I),,iConn
        Conn.Execute sqlCol(I), j
        If WARN = 1 And err.Number <> 0 Then
            DoCmd.Hourglass False
            MsgBox "【错误提示】：第 " & I & " 行：" & Replace(err.Description, "[Microsoft][ODBC driver for oracle][Oracle]", "") & _
                   vbNewLine & "【错误语句】：" & (sqlCol(I)), , "系统提示"
            DoCmd.Hourglass True
        End If
    Next
    DoCmd.Hourglass False
    If notrs = 0 Then
        If WARN = 1 Then
            If MsgBox("是否保存修改结果？", vbExclamation + vbYesNo + vbDefaultButton2, "提交事务") = vbYes Then
                Conn.CommitTrans    '提交事务
                ExCol = 1
            Else
                Conn.RollbackTrans
            End If
        Else
            Conn.CommitTrans    '提交事务
            ExCol = 1
        End If
    Else
        If err.Number = 0 Then ExCol = 1
    End If
    If ExCol = 1 Then
        For I = 1 To sqlCol.Count
            sqlCol.Remove 1    ' 将第一个对象删除            ' 直到删除所有对象为止。
        Next
    End If
    If Conn.State = 1 Then Conn.Close
    Exit Function
ExCol_Error:
    DoCmd.Hourglass False
    ExCol = 0
    '    FrmName = Screen.ActiveForm.Caption
    If notrs = 0 Then Conn.RollbackTrans
    If Conn.State = 1 Then Conn.Close
    MsgBox "【错误提示】：第 " & I & " 行——" & Replace(err.Description, "[Microsoft][ODBC driver for oracle][Oracle]", "") & vbNewLine & _
           "【错误语句】：" & (sqlCol(I)), , "系统提示：" & FrmName
End Function