Access VBA 事务处理（下）：用 ADO 连 SQL Server，一张单据要么全存要么全撤

Access VBA 事务处理（下）：用 ADO 连 SQL Server，一张单据要么全存要么全撤

Hi，大家好！

上一篇用 DAO 写了出库单的事务：主表、明细、扣库存放在一个 Workspace 事务里，一步失败就全部撤回。

那套写法适合 Access 自己的表。后端换成 SQL Server 以后，我会换一种做法：不走链接表，直接用 ADO 连到 SQL Server，在同一个连接上开事务、执行语句、提交或回滚。数据怎么改、什么时候算保存成功，都由这一个连接说了算。

例子还是那张出库单，方便和上一篇对照着看。

ADO 的事务挂在连接上

DAO 的事务属于 Workspace，ADO 的事务属于 Connection，方法名也略有不同：

规则只有一条：只有通过这个 cn 执行的语句，才在这个事务里。另开一个连接执行的语句、链接表上的修改、绑定窗体的保存，都不归它管。

SQL Server 这边的表

三张正式表放在 SQL Server：

CREATE TABLE dbo.Stock (
    ProductID int NOT NULL PRIMARY KEY,
    Qty int NOT NULL
);

CREATE TABLE dbo.StockOut (
    OutID int IDENTITY(1,1) PRIMARY KEY,
    OutNo nvarchar(20) NOT NULL UNIQUE,
    OutDate datetime2(0) NOT NULL
);

CREATE TABLE dbo.StockOutDetail (
    DetailID int IDENTITY(1,1) PRIMARY KEY,
    OutID int NOT NULL REFERENCES dbo.StockOut (OutID),
    ProductID int NOT NULL REFERENCES dbo.Stock (ProductID),
    Qty int NOT NULL CHECK (Qty > 0)
);

Access 前端里仍然保留临时表 tmpStockOutLine，字段 ProductID、Qty，明细子窗体绑定它。用户在临时表里录入、修改，点保存时代码读出来，在一个 ADO 事务里写进 SQL Server。

引用和连接字符串

代码用前期绑定，需要在 VBA 编辑器的「工具 - 引用」里勾选 Microsoft ActiveX Data Objects 6.1 Library，版本号以你电脑上的为准。

连接用 MSOLEDBSQL，也就是新版的 Microsoft OLE DB Driver for SQL Server，客户端电脑需要先安装。老系统里常见的 SQLOLEDB 也能连，只是微软已经不再给它加新功能。

保存出库单的完整代码

新建标准模块 modStockOutSql：

Option Compare Database
Option Explicit

Private Const CONN_STR As String = _
    "Provider=MSOLEDBSQL;Data Source=你的服务器;Initial Catalog=你的数据库;" & _
    "Integrated Security=SSPI;"

Private Function NewCommand(ByVal cn As ADODB.Connection, ByVal strSQL As String) As ADODB.Command
    Dim cmd As ADODB.Command

    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = cn
    cmd.CommandType = adCmdText
    cmd.CommandText = strSQL
    cmd.CommandTimeout = 30
    Set NewCommand = cmd
End Function

Public Function SaveStockOutSql(ByVal strOutNo As String, ByVal dtOut As Date) As Boolean
    Dim cn As ADODB.Connection
    Dim cmdHead As ADODB.Command
    Dim cmdDetail As ADODB.Command
    Dim cmdStock As ADODB.Command
    Dim rsNew As ADODB.Recordset
    Dim rsLine As DAO.Recordset
    Dim lngOutID As Long
    Dim lngAffected As Long
    Dim blnInTrans As Boolean
    Dim lngErr As Long
    Dim strErr As String

    On Error GoTo ErrHandler

    Set rsLine = CurrentDb.OpenRecordset("SELECT ProductID, Qty FROM tmpStockOutLine", dbOpenSnapshot)
    If rsLine.EOF Then
        Err.Raise vbObjectError + 1001, , "出库明细为空。"
    End If

    Set cn = New ADODB.Connection
    cn.ConnectionString = CONN_STR
    cn.Open

    Set cmdHead = NewCommand(cn, _
        "INSERT INTO dbo.StockOut (OutNo, OutDate) OUTPUT INSERTED.OutID VALUES (?, ?)")
    cmdHead.Parameters.Append cmdHead.CreateParameter("OutNo", adVarWChar, adParamInput, 20, strOutNo)
    cmdHead.Parameters.Append cmdHead.CreateParameter("OutDate", adDBTimeStamp, adParamInput, , dtOut)

    Set cmdDetail = NewCommand(cn, _
        "INSERT INTO dbo.StockOutDetail (OutID, ProductID, Qty) VALUES (?, ?, ?)")
    cmdDetail.Parameters.Append cmdDetail.CreateParameter("OutID", adInteger, adParamInput)
    cmdDetail.Parameters.Append cmdDetail.CreateParameter("ProductID", adInteger, adParamInput)
    cmdDetail.Parameters.Append cmdDetail.CreateParameter("Qty", adInteger, adParamInput)

    Set cmdStock = NewCommand(cn, _
        "UPDATE dbo.Stock SET Qty = Qty - ? WHERE ProductID = ? AND Qty >= ?")
    cmdStock.Parameters.Append cmdStock.CreateParameter("Qty", adInteger, adParamInput)
    cmdStock.Parameters.Append cmdStock.CreateParameter("ProductID", adInteger, adParamInput)
    cmdStock.Parameters.Append cmdStock.CreateParameter("MinQty", adInteger, adParamInput)

    cn.BeginTrans
    blnInTrans = True

    Set rsNew = cmdHead.Execute
    lngOutID = rsNew.Fields(0).Value
    rsNew.Close

    cmdDetail.Parameters("OutID").Value = lngOutID

    Do Until rsLine.EOF
        cmdDetail.Parameters("ProductID").Value = rsLine!ProductID
        cmdDetail.Parameters("Qty").Value = rsLine!Qty
        cmdDetail.Execute , , adExecuteNoRecords

        cmdStock.Parameters("Qty").Value = rsLine!Qty
        cmdStock.Parameters("ProductID").Value = rsLine!ProductID
        cmdStock.Parameters("MinQty").Value = rsLine!Qty
        cmdStock.Execute lngAffected, , adExecuteNoRecords

        If lngAffected <> 1 Then
            Err.Raise vbObjectError + 1002, , "产品 " & rsLine!ProductID & " 库存不足或不存在。"
        End If

        rsLine.MoveNext
    Loop

    cn.CommitTrans
    blnInTrans = False
    SaveStockOutSql = True

ExitHere:
    On Error Resume Next
    If blnInTrans Then cn.RollbackTrans
    If Not rsNew Is Nothing Then
        If rsNew.State = adStateOpen Then rsNew.Close
    End If
    If Not rsLine Is Nothing Then rsLine.Close
    If Not cn Is Nothing Then
        If cn.State = adStateOpen Then cn.Close
    End If
    Set rsNew = Nothing
    Set rsLine = Nothing
    Set cmdHead = Nothing
    Set cmdDetail = Nothing
    Set cmdStock = Nothing
    Set cn = Nothing
    If lngErr <> 0 Then
        MsgBox "出库单没有保存，所有修改已撤销。" & vbCrLf & strErr, vbExclamation
    End If
    Exit Function

ErrHandler:
    lngErr = Err.Number
    strErr = Err.Description
    Resume ExitHere
End Function

窗体上的调用和上一篇一样，只是函数名换成 SaveStockOutSql。

读临时表那一句用的是 DAO，它只读前端的本地数据，不参与 SQL Server 的事务，这里是有意这样分开的：本地负责录入，SQL Server 负责正式保存。

代码里的几处安排

三条命令在开事务之前准备好

Command 对象和参数，我都在 BeginTrans 之前建好，循环里只改参数值、执行。

一方面，同一条语句反复执行，不用每次重新拼。另一方面，事务开启以后，SQL Server 会一直持有相关的锁，这段时间里做的准备工作越少越好。

用参数，不拼字符串

单号是用户输入的文本，直接拼进 SQL，碰到单引号就会报错，被人故意构造内容时还有注入风险。参数化以后，这两个问题都不存在。

注意 ADO 的 ? 参数是按位置对应的，不是按名字。CreateParameter 里写的名字只是方便自己在后面用 Parameters("Qty") 取值，追加顺序必须和 SQL 里问号的顺序一致。扣库存那条语句里数量出现了两次，所以要追加两个参数。

新主键用 OUTPUT 直接拿回来

主表是 IDENTITY 自增列，明细需要这个编号。我用的是 OUTPUT INSERTED.OutID，插入语句执行完直接返回一个只有一行一列的记录集。

它和插入在同一条语句里，取到的一定是这一次插入的编号。不用再单独查一次，也不用考虑 @@IDENTITY 被触发器干扰的问题。

有一点要知道：如果 StockOut 表上建了触发器，不带 INTO 的 OUTPUT 子句会报错。这时可以改用 OUTPUT ... INTO 一个表变量，或者在同一批语句里用 SCOPE_IDENTITY()。

影响行数从 Execute 的第一个参数拿

扣库存的逻辑和上一篇一样，靠 WHERE Qty >= ? 防止扣成负数，库存不够时语句不报错，只是一行也不改。

ADO 里取影响行数，是把一个变量传给 Execute 的第一个参数，执行后这个变量就是受影响的行数。不是 1，就主动抛错，走到回滚。

SQL Server 可能先替你回滚了

这是 ADO 事务里比较隐蔽的一点。

有些错误发生后，SQL Server 会自己把事务回滚掉，比如这个连接被选为死锁的牺牲者，或者服务器设置了 XACT_ABORT ON，语句一出错整个事务就终止。这时候 VBA 里再执行 cn.RollbackTrans，会报一个「没有活动事务」之类的错误。

所以清理段我放在 On Error Resume Next 下面，回滚失败也不影响后面关闭连接和提示用户。数据这边没有问题，服务器已经撤销了。

遇到死锁失败的单据，重新点一次保存一般就能成功。如果死锁经常出现，就要回头看多张单据更新同一批库存记录时的顺序和索引，这已经不是 VBA 层面能解决的了。

不要在事务里等用户

和 DAO 一样，BeginTrans 到 CommitTrans 之间，不要弹对话框，不要让用户确认任何东西。

SQL Server 在事务结束之前会一直保持锁。默认的「读已提交」隔离级别下，别人查询被你锁住的库存记录，会一直等到你提交或回滚。前端看起来就是程序卡住了。

需要用户确认的内容，在开事务之前问完；需要提示的结果，在事务结束之后再弹。

同一个事务里，别混用 DAO 和 ADO 写数据

有的系统里，后端是 SQL Server，表也都链接进来了。于是代码里一半用 CurrentDb.Execute 改链接表，一半用 ADO 连接执行语句，再在 ADO 上开一个事务。

这样写，cn.RollbackTrans 只能撤回 ADO 那一半。链接表走的是 Access 自己的 ODBC 连接，和你的 cn 是两个会话，它的修改不在这个事务里。更麻烦的是，两边可能还会互相等锁。

所以一次保存里，所有写正式表的语句都放到同一个 cn 上执行。

CurrentProject.Connection 也是一样的道理。它是一个指向当前 Access 数据库的 ADO 连接，可以在上面开事务，但它管不到 DAO 的 Workspace，也管不到 SQL Server 那边的数据。

逻辑复杂了，就放进存储过程

上面的例子是三类语句，放在 VBA 里还能看清楚。如果保存一张单据还要写流水、改批次、算成本，我会把整段逻辑放进存储过程，VBA 只负责传参数和接收结果。

CREATE PROCEDURE dbo.usp_SaveStockOut
    @OutNo nvarchar(20),
    @OutDate datetime2(0)
AS
BEGIN
    SET NOCOUNT ON;
    SET XACT_ABORT ON;

    BEGIN TRY
        BEGIN TRANSACTION;

        -- 写主表、明细、扣库存

        COMMIT TRANSACTION;
    END TRY
    BEGIN CATCH
        IF @@TRANCOUNT > 0 ROLLBACK TRANSACTION;
        THROW;
    END CATCH
END

事务在服务器端开始和结束，网络中断、Access 卡死都不会留下一个悬着的事务。明细怎么传给存储过程，可以用表值参数，也可以先写进一张按会话区分的中间表，这部分之后有机会单独写。

两篇放在一起看

后端是 Access 的 accdb，用 DAO 的 Workspace 事务，配合 dbFailOnError 和 RecordsAffected。

后端是 SQL Server，用一个 ADO 连接，参数化命令，所有写操作走这一个连接；逻辑复杂了就交给存储过程。

两种写法的思路其实一样：录入阶段不碰正式表，保存时一次写完，任何一步不对就整单撤回，弹窗留到事务结束以后。

技术培训

• Access VBA 从入门到精通（线上/线下均可）

• Access + SQL Server 企业级开发实战

• Access 系统性能优化与架构设计

• AI + Access 融合开发专题培训

定制开发

• 企业 ERP / CRM / 进销存 / WMS / MES 等系统开发

• 旧 Access 系统升级、性能优化与架构重构

• AI 能力集成到现有 Access 业务系统

技术支持

• 代码审查与重构建议

• 疑难问题远程诊断

• 一对一技术辅导