VB6+ADO访问SQL Server 2019链接服务器更新失败求助

针对你遇到的两种锁模式报错，提供以下几种可行方案：

方案1：为远程表添加时间戳列（适配adLockOptimistic） #

错误16964明确指出，乐观游标更新远程对象必须有时间戳列。你可以给目标表添加一个TIMESTAMP类型的列，步骤如下：

1. 在远程服务器（NASMSPAINT对应的实例）执行SQL：

ALTER TABLE [Ignition].[dbo].[booth_Styles] 
ADD RowVersion TIMESTAMP; -- TIMESTAMP是ROWVERSION的别名，功能完全一致

2. 修改VB6代码中的SELECT语句，确保包含这个新列：

.Open "SELECT *, RowVersion FROM [NASMSPAINT].[Ignition].[dbo].[booth_Styles] WHERE [Booth] = 'AdPro' ORDER BY [StyleID]", Conn, adOpenDynamic, adLockOptimistic

之后再执行.Update就不会触发16964错误，时间戳列会自动参与乐观锁的冲突检测。

方案2：直接执行UPDATE语句绕开Recordset游标 #

既然Python能成功更新，说明直接执行SQL是可行的。你可以放弃Recordset的逐行更新，改用ADO的Connection.Execute执行参数化UPDATE语句，完全避开游标锁的限制：

sDBName = "PROVIDER=SQLOLEDB.1;Data Source=192.168.2.70;User ID=xxxx;Password=xxxx;Persist Security Info=False"

Dim Conn As ADODB.Connection
Dim sSQL As String
Dim nThisStyle As Integer

Set Conn = New ADODB.Connection
Conn.Open sDBName

nThisStyle = 1
' 先获取所有需要更新的StyleID，确保循环对应正确记录
Dim rsKeys As ADODB.Recordset
Set rsKeys = New ADODB.Recordset
rsKeys.Open "SELECT StyleID FROM [NASMSPAINT].[Ignition].[dbo].[booth_Styles] WHERE [Booth] = 'AdPro' ORDER BY [StyleID]", Conn, adOpenForwardOnly, adLockReadOnly

rsKeys.MoveFirst
Do Until rsKeys.EOF
    sSQL = "UPDATE [NASMSPAINT].[Ignition].[dbo].[booth_Styles] " & _
           "SET Plant_Number = ?, Style_Number = ?, Descript = ?, Robots_Required = ? " & _
           "WHERE StyleID = ? AND Booth = 'AdPro'"
    ' 参数化查询避免SQL注入，同时确保字段匹配
    Conn.Execute sSQL, Array( _
        Style_Data(nThisStyle).PlantStyle, _
        Style_Data(nThisStyle).FanucStyle, _
        Style_Data(nThisStyle).StyleDesc, _
        Style_Data(nThisStyle).StyleRobotsReq, _
        rsKeys!StyleID _
    )
    rsKeys.MoveNext
    nThisStyle = nThisStyle + 1
Loop
rsKeys.Close
Set rsKeys = Nothing
Conn.Close
Set Conn = Nothing

这种方式不依赖游标锁，性能更高效，尤其适合批量更新场景。

方案3：使用批量更新模式（adLockBatchOptimistic） #

如果必须保留Recordset的使用方式，可以尝试批量更新模式，将所有修改缓存后一次性提交：

sDBName = "PROVIDER=SQLOLEDB.1;Data Source=192.168.2.70;User ID=xxxx;Password=xxxx;Persist Security Info=False"

Dim Conn As ADODB.Connection
Dim rs As ADODB.Recordset

Set Conn = New ADODB.Connection
Conn.Open sDBName
Set rs = New ADODB.Recordset

With rs
    ' 改用批量乐观锁
    .Open "SELECT * FROM [NASMSPAINT].[Ignition].[dbo].[booth_Styles] WHERE [Booth] = 'AdPro' ORDER BY [StyleID]", Conn, adOpenDynamic, adLockBatchOptimistic
    .MoveFirst
    nThisStyle = 1
    Do Until .EOF
        ![Plant_Number] = Style_Data(nThisStyle).PlantStyle
        ![Style_Number] = Style_Data(nThisStyle).FanucStyle
        ![Descript] = Style_Data(nThisStyle).StyleDesc
        ![Robots_Required] = Style_Data(nThisStyle).StyleRobotsReq
        ' 去掉逐行的.Update，缓存修改
        .MoveNext
        nThisStyle = nThisStyle + 1
    Loop
    ' 一次性提交所有修改
    .UpdateBatch
End With
rs.Close
Set rs = Nothing
Conn.Close
Set Conn = Nothing

注意：批量更新需要链接服务器支持分布式事务，你已开启Enable Promotion of Distributed Transaction:TRUE，理论上可正常运行。

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