如何通过ADO Recordset修改Access数据库中的指定记录

需求说明 #

• 以Excel用户窗体为前端，无需打开Access即可编辑database3.mdb中的记录
• 匹配用户窗体TextBox2的值与Access表Table1的ID字段，用TextBox1的值替换对应记录的Column1字段值

原代码存在的问题 #

• 连接字符串不完整：末尾;Jet OLEDB:Database无有效参数，会导致连接失败
• 匹配逻辑错误：错误将Column1作为匹配字段，实际应匹配ID字段
• 记录集编辑语法错误：Edit方法调用后不能直接链式访问字段，需分开执行
• 缺少记录集遍历逻辑：仅判断第一条记录，无法找到所有匹配的ID
• 对象引用缺失：.Update、.Close未指定对象，会触发编译错误
• 未处理记录集未打开的情况：直接关闭可能引发异常

修正后的代码（两种实现方式） #

方式1：使用记录集遍历（适合需要额外处理记录的场景）

Sub Save_Data()
    On Error GoTo ErrorHandler
    
    Application.EnableCancelKey = xlDisabled
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Dim nConnection As New ADODB.Connection
    Dim nRecordset As New ADODB.Recordset
    Dim sqlQuery As String
    Dim dbPath As String
    
    ' 数据库路径，可根据实际情况调整
    dbPath = "C:\Users\sam\Desktop\Database3.mdb"
    
    ' 适配64/32位系统的连接字符串
    #If Win64 Then
        nConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
    #Else
        nConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
    #End If
    
    ' 仅查询需要匹配的字段，减少数据传输
    sqlQuery = "SELECT ID, Column1 FROM Table1 WHERE ID = '" & UserForm1.TextBox2.Value & "'"
    nRecordset.Open Source:=sqlQuery, ActiveConnection:=nConnection, _
                   CursorType:=adOpenKeyset, LockType:=adLockOptimistic
    
    ' 更新匹配的记录
    If Not nRecordset.EOF Then
        nRecordset.Edit
        nRecordset.Fields("Column1").Value = UserForm1.TextBox1.Value
        nRecordset.Update
    End If
    
    ' 关闭记录集和连接
    If nRecordset.State = adStateOpen Then nRecordset.Close
    If nConnection.State = adStateOpen Then nConnection.Close
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub
    
ErrorHandler:
    MsgBox "错误描述：" & Err.Description & "，错误编号：" & Err.Number, vbOKOnly + vbCritical, "数据库错误"
    
    ' 确保资源释放
    If nRecordset.State = adStateOpen Then nRecordset.Close
    If nConnection.State = adStateOpen Then nConnection.Close
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

方式2：直接使用SQL更新语句（更高效，减少数据库占用）

Sub Save_Data_SQL()
    On Error GoTo ErrorHandler
    
    Application.EnableCancelKey = xlDisabled
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Dim nConnection As New ADODB.Connection
    Dim sqlUpdate As String
    Dim dbPath As String
    
    dbPath = "C:\Users\sam\Desktop\Database3.mdb"
    
    #If Win64 Then
        nConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
    #Else
        nConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
    #End If
    
    ' 构造SQL更新语句，注意参数转义避免注入
    sqlUpdate = "UPDATE Table1 SET Column1 = '" & Replace(UserForm1.TextBox1.Value, "'", "''") & _
                "' WHERE ID = '" & Replace(UserForm1.TextBox2.Value, "'", "''") & "'"
    
    ' 执行更新
    nConnection.Execute sqlUpdate
    
    ' 关闭连接
    If nConnection.State = adStateOpen Then nConnection.Close
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub
    
ErrorHandler:
    MsgBox "错误描述：" & Err.Description & "，错误编号：" & Err.Number, vbOKOnly + vbCritical, "数据库错误"
    
    If nConnection.State = adStateOpen Then nConnection.Close
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

注意事项 #

• 需确保Excel已引用Microsoft ActiveX Data Objects x.x Library（在VBA编辑器的「工具」→「引用」中勾选）
• 若数据库有密码，需在连接字符串中添加;Jet OLEDB:Database Password=你的密码
• 方式2中使用Replace处理单引号，避免SQL注入风险，适合直接更新的场景

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