SQL Server事务引发MS Access VBA查询超时问题排查

在MS Access中使用以下VBA代码时，移除Conn.BeginTrans和Conn.CommitTrans事务命令后代码运行正常，但保留事务命令时，执行INSERT INTO tbl1ShipmentDetails语句的第二个循环周期会收到SQL Server返回的“查询超时”错误。相关代码如下：

Private Sub cmdShipOrder_Click()

    Dim intShipmentID As Integer
    Dim rsShipment, rsShipmentDetail As Recordset
    
    On Error GoTo ErrHandler

    If Me.ReservationStatus <> "ZBOŽÍ KOMPLETNĚ REZERVOVÁNO" Then
        MsgBox "Nejprve je nutné do objednávky rezervovat hmotné zboží.", vbCritical + vbOKOnly, "Chyba"
        Exit Sub
    End If
    
    If MsgBox("Bude vytvořena expedice a celá objednávka bude označena jako expedovaná. Pokračovat?", vbExclamation + vbYesNoCancel, "Upozornění") <> vbYes Then Exit Sub
    
    Connect
    
    Exec "INSERT INTO tbl1Shipments (CustomerID, ShippingMethodID, ShipToID, CarrierID, ShipmentCode, DateShipped) " & _
            "VALUES (" & Me.CustomerID & ", " & _
                    Me.ShippingMethodID & ", " & _
                    Me.ShipToID & ", " & _
                    Me.CarrierID & ", " & _
                    "'" & Year(Date) & "EXP" & Format(DCount("*", "dbo_tbl1Shipments", "ShipmentCode LIKE '%" & Year(Date) & "EXP%'") + 1, "000") & "', " & _
                    "GETDATE())"
                    
    intShipmentID = DMax("ShipmentID", "dbo_tbl1Shipments", "CustomerID=" & Me.CustomerID)
    
    Conn.BeginTrans

    Set rsShipment = CurrentDb.OpenRecordset("SELECT * FROM dbo_v_SalesOrderSub WHERE SalesOrderID=" & Me.SalesOrderID)
    rsShipment.MoveFirst

    Do Until rsShipment.BOF Or rsShipment.EOF
        Exec "INSERT INTO tbl1ShipmentDetails (ShipmentID, SalesOrderDetailID, Quantity) " & _
                "VALUES (" & intShipmentID & ", " & _
                        rsShipment("SalesOrderDetailID") & ", " & _
                        rsShipment("Quantity") & ")"
        rsShipment.MoveNext
    Loop

    Set rsShipmentDetail = CurrentDb.OpenRecordset("SELECT * FROM dbo_v_ShipmentSub WHERE ShipmentID=" & intShipmentID)
    rsShipmentDetail.MoveFirst

    Do Until rsShipmentDetail.BOF Or rsShipmentDetail.EOF
        If rsShipmentDetail("ProductTypeID") <> 3 Then
            Exec "UPDATE tbl1Units " & _
                    "SET ShipmentDetailID=" & rsShipmentDetail("ShipmentDetailID") & " " & _
                    "WHERE SalesOrderDetailID=" & rsShipmentDetail("SalesOrderDetailID")
        End If
        rsShipmentDetail.MoveNext
    Loop

    Conn.CommitTrans

    rsShipment.Close
    Set rsShipment = Nothing

    rsShipmentDetail.Close
    Set rsShipmentDetail = Nothing

    Disconnect

Exit Sub

ErrHandler:
    MsgBox "CHYBA: " & Err.Description
    Conn.RollbackTrans
    Exec "DELETE FROM tbl1Shipments WHERE ShipmentID=" & intShipmentID
    If Not rsShipment Is Nothing Then
        rsShipment.Close
        Set rsShipment = Nothing
    End If
    If Not rsShipmentDetail Is Nothing Then
        rsShipmentDetail.Close
        Set rsShipmentDetail = Nothing
    End If
    Disconnect
End Sub

• 连接上下文不统一：代码同时混用了两种数据访问方式——自定义ADO连接（Conn对象、Connect/Exec/Disconnect）和Access自带的CurrentDb。开启事务的是ADO的Conn连接，但CurrentDb.OpenRecordset用的是Access自身的默认连接，和ADO事务不在同一个上下文。事务中ADO操作修改数据后，CurrentDb的记录集要么无法读取最新数据，要么触发SQL Server的锁等待，循环到第二次就直接超时。
• 锁竞争拖慢执行：SQL Server默认事务隔离级别为READ COMMITTED，ADO事务未提交时，插入的tbl1ShipmentDetails数据处于未提交状态，CurrentDb的查询会等待锁释放，这种阻塞在循环中累积，很快触发超时。
• 循环逐行操作效率低下：循环内逐行执行INSERT和UPDATE本身效率就低，再加上连接不一致导致的锁问题，进一步放大了超时概率。

1. 统一使用ADO连接：全程仅使用ADO的Conn对象，不再混用CurrentDb。将所有CurrentDb.OpenRecordset替换为Conn.OpenRecordset，确保所有操作都处于同一个ADO事务上下文，示例：

   ' 替换原CurrentDb的记录集打开方式
   Set rsShipment = Conn.OpenRecordset("SELECT * FROM dbo_v_SalesOrderSub WHERE SalesOrderID=" & Me.SalesOrderID)
   

2. 改为批量操作：将循环内的逐行INSERT和UPDATE替换为批量SQL语句，比如用INSERT ... SELECT一次性插入所有明细，减少与SQL Server的交互次数，从根源降低锁竞争概率。
3. 调整事务隔离级别：若业务允许，可将ADO连接的隔离级别改为READ UNCOMMITTED（注意：该级别会读取未提交数据，关键业务场景慎用），或在SQL Server开启READ COMMITTED SNAPSHOT快照隔离，避免读操作等待写锁。
4. 临时增加超时时间：可调整ADO连接的CommandTimeout属性，给事务内的操作预留更多执行时间，但这仅为临时缓解方案，彻底解决需从统一连接方式入手。

内容的提问来源于stack exchange，提问作者ThomassoCZ