Access链接SharePoint列表时事务回滚失效问题排查

将Excel数据插入链接至SharePoint列表的Access表时，数据插入功能正常，但事务机制完全失效：执行rs.Update后新条目立即同步到SharePoint，调用ws.Rollback无法回滚已插入的数据。

链接到SharePoint列表的Access表本质是通过ODBC驱动直接映射到SharePoint远程数据源，而非本地Access表：

• DAO的Workspace.BeginTrans事务仅作用于本地Access数据库的操作，无法覆盖远程SharePoint的数据源操作。
• 执行rs.Update时，Access会通过ODBC直接向SharePoint提交数据，该操作即时生效，不受本地DAO事务控制，因此后续的Rollback无法撤销已提交到SharePoint的记录。

方法1：使用本地临时表做缓冲（推荐） #

先将待插入数据写入本地Access临时表，利用DAO事务控制本地操作；用户确认保存后，再批量将临时表数据同步到SharePoint链接表。

修改后核心代码示例 #

Private Sub InsertData()
    Dim ws As DAO.Workspace
    Dim db As DAO.Database
    Dim rsTemp As DAO.Recordset2
    Dim rsSP As DAO.Recordset2
    Dim sowItem As clsSowingEntry
    Dim dKey As Variant
    Dim crit As String

    On Error GoTo errHandler

    If datadict.Count = 0 Then
        MsgBox "No valid sowing events were found."
        Set datadict = Nothing
        Exit Sub
    End If

    Set ws = DBEngine.Workspaces(0)
    Set db = ws.OpenDatabase(accessPath)
    ' 打开本地临时表（需提前创建与SharePoint链接表结构一致的表）
    Set rsTemp = db.OpenRecordset("Temp_FormData", dbOpenDynaset)
    Set rsSP = db.OpenRecordset("FormData")

    ws.BeginTrans
    ' 先写入本地临时表，受DAO事务控制
    For Each dKey In datadict.Keys
        Set sowItem = datadict(dKey)
        crit = "EventTypeId = 1 AND ProductionLineCode = '" & sowItem.ProductionLine & "' AND ProductCode = '" & sowItem.ProductCode & "' AND EventDate = " & sowItem.SowingDate
        
        rsSP.FindFirst crit
        If rsSP.NoMatch Then
            rsTemp.AddNew
            rsTemp!SowingDate = sowItem.SowingDate
            rsTemp!EventDate = sowItem.SowingDate
            rsTemp!EmployeeName = sowItem.SowerName
            rsTemp!EventTypeId = sowItem.EventTypeId
            rsTemp!ProductionLineCode = sowItem.ProductionLine
            rsTemp!ProductCode = sowItem.ProductCode
            rsTemp!UnitCode = sowItem.UnitCode
            rsTemp!GreenHouseCode = sowItem.GreenHouseCode
            rsTemp!Quantity = sowItem.ActualCellCount
            rsTemp!SeedBatchNumber = sowItem.SeedBatchNo
            rsTemp.Update
        End If
    Next

    If MsgBox("Save changes?", vbQuestion + vbYesNo) = vbYes Then
        ' 用户确认后，批量同步到SharePoint链接表
        rsTemp.MoveFirst
        Do While Not rsTemp.EOF
            rsSP.AddNew
            ' 复制临时表字段值到SharePoint链接表
            rsSP!SowingDate = rsTemp!SowingDate
            rsSP!EventDate = rsTemp!EventDate
            rsSP!EmployeeName = rsTemp!EmployeeName
            rsSP!EventTypeId = rsTemp!EventTypeId
            rsSP!ProductionLineCode = rsTemp!ProductionLine
            rsSP!ProductCode = rsTemp!ProductCode
            rsSP!UnitCode = rsTemp!UnitCode
            rsSP!GreenHouseCode = rsTemp!GreenHouseCode
            rsSP!Quantity = rsTemp!Quantity
            rsSP!SeedBatchNumber = rsTemp!SeedBatchNo
            rsSP.Update
            rsTemp.MoveNext
        Loop
        ws.CommitTrans
        ' 清空临时表
        db.Execute "DELETE * FROM Temp_FormData"
    Else
        ' 回滚本地临时表的操作
        ws.Rollback
    End If

    ' 清理资源
    rsTemp.Close
    rsSP.Close
    db.Close
    ws.Close

    Set db = Nothing
    Set rsTemp = Nothing
    Set rsSP = Nothing
    Set ws = Nothing
    Set sowItem = Nothing
    Set datadict = Nothing

    Exit Sub

errHandler:
    ws.Rollback
    rsTemp.Close
    rsSP.Close
    db.Close
    ws.Close

    Set db = Nothing
    Set rsTemp = Nothing
    Set rsSP = Nothing
    Set ws = Nothing
    Set sowItem = Nothing
    Set datadict = Nothing

    Call Common.FatalError(Err.Description)
End Sub

方法2：使用ADODB事务操作SharePoint OData接口 #

通过ADODB直接连接SharePoint的OData服务，利用ADODB的事务机制控制远程操作，确保提交前可回滚。核心步骤：

• 构建SharePoint OData连接字符串
• 打开ADODB连接并开启事务
• 执行插入操作后，根据用户选择提交或回滚

方法3：手动回滚（应急方案） #

如果无法修改现有架构，可在插入记录时保存所有新插入记录的唯一标识（如SharePoint列表的ID）；当需要回滚时，根据这些标识批量删除SharePoint中的对应记录。缺点是数据会短暂暴露在SharePoint中，且需处理并发冲突。

Private Sub InsertData()
    
    
    Dim dbConnection As New ADODB.Connection
    Dim dbCommand As New ADODB.Command
    Dim ws As DAO.Workspace
    Dim rs As DAO.Recordset2
    Dim db As DAO.Database
    Dim sowItem As clsSowingEntry
    Dim crit As String
    Dim dKey As Variant
    Dim rsEvent As DAO.Recordset2
    
    On Error GoTo errHandler
    
    If datadict.Count = 0 Then
        Set datadict = Nothing
        MsgBox ("No valid sowing events were found.")
        End
    End If
    
    Set ws = DBEngine.Workspaces(0)
    Set db = ws.OpenDatabase(accessPath)
    Set rs = db.OpenRecordset("FormData")
    Set rsEvent = db.OpenRecordset("EventType")
            
    ws.BeginTrans
    For Each dKey In datadict.Keys
    
        Set sowItem = datadict(dKey)
        
        crit = "EventTypeId = 1 AND ProductionLineCode = '" & sowItem.ProductionLine & "' AND ProductCode = '" & sowItem.ProductCode & "' AND EventDate = " & sowItem.SowingDate
        
        rs.FindFirst crit
        If rs.NoMatch Then
            'Insert New Record
            rs.AddNew
            rs!SowingDate = sowItem.SowingDate
            rs!EventDate = sowItem.SowingDate
            rs!EmployeeName = sowItem.SowerName
            rs!EventTypeId = sowItem.EventTypeId
            rs!ProductionLineCode = sowItem.ProductionLine
            rs!ProductCode = sowItem.ProductCode
            rs!UnitCode = sowItem.UnitCode
            rs!GreenHouseCode = sowItem.GreenHouseCode
            rs!Quantity = sowItem.ActualCellCount
            rs!SeedBatchNumber = sowItem.SeedBatchNo
            rs.Update
        End If
        
    Next
    
    If MsgBox("Save changes?", vbQuestion + vbYesNo) = vbYes Then
        ws.CommitTrans
    Else
        ws.Rollback
    End If
    
    rs.Close
    db.Close
    ws.Close
    
    Set db = Nothing
    Set rs = Nothing
    Set ws = Nothing
    Set sowItem = Nothing
    Set datadict = Nothing
    
    Exit Sub
    
errHandler:
    ws.Rollback
    rs.Close
    db.Close
    ws.Close
    
    Set db = Nothing
    Set rs = Nothing
    Set ws = Nothing
    Set sowItem = Nothing
    Set datadict = Nothing
    
    Call Common.FatalError(Err.Description)
    
End Sub

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