使用VBA从表单更新tblItems表时的记录查询异常问题

问题根源分析 #

你的代码存在三个核心问题，导致查找功能失效：

1. 未检查查找结果：FindFirst执行后没有判断是否找到匹配记录，若查找失败，记录集会停在第一条记录上。
2. 错误的编辑时机：查找阶段调用rs.Edit和rs.Update完全多余，这会无意义地更新当前（可能是第一条）记录，且偏离了"先查找再修改"的逻辑。
3. 字段类型拼接漏洞：如果Item_ID是文本类型，直接拼接条件会触发SQL语法错误，导致查找失败。

修正后的查找按钮代码 #

Private Sub btnFind_Click()
    Dim rs As Recordset
    Dim strCriteria As String
    
    ' 校验输入合法性
    If IsNull(tbItemID.Value) Or tbItemID.Value = "" Then
        MsgBox "请输入有效的Item编号", vbExclamation
        tbItemID.SetFocus
        Exit Sub
    End If
    
    ' 根据Item_ID字段类型构建查询条件
    ' 若Item_ID是数字类型，使用此行：
    strCriteria = "Item_ID = " & tbItemID.Value
    ' 若Item_ID是文本类型，替换为（注意单引号和转义）：
    ' strCriteria = "Item_ID = '" & Replace(tbItemID.Value, "'", "''") & "'"
    
    Set rs = CurrentDb.OpenRecordset("tblItems", dbOpenDynaset)
    rs.FindFirst strCriteria
    
    ' 判断是否找到匹配记录
    If rs.NoMatch Then
        MsgBox "未找到对应编号的记录", vbInformation
        ' 清空控件并恢复状态
        tbDesc.Value = ""
        cbUOM.Value = ""
        tbCost.Value = ""
        tbItemID.Enabled = True
    Else
        ' 加载找到的记录到表单控件
        tbItemID.Enabled = False
        
        lblDesc.Visible = True
        tbDesc.Visible = True
        tbDesc.Value = rs!Description
        
        lblUOM.Visible = True
        cbUOM.Visible = True
        cbUOM.Value = rs!UOM
        cbUOM.Enabled = False
        
        lblCost.Visible = True
        tbCost.Visible = True
        tbCost.Value = rs!Cost
    End If
    
    rs.Close
    Set rs = Nothing
End Sub

新增保存按钮代码（实现修改后更新） #

在表单添加一个保存按钮（命名为btnSave），绑定以下代码完成记录更新：

Private Sub btnSave_Click()
    Dim rs As Recordset
    Dim strCriteria As String
    
    If IsNull(tbItemID.Value) Or tbItemID.Value = "" Then
        MsgBox "无有效记录可保存", vbExclamation
        Exit Sub
    End If
    
    ' 同样根据字段类型构建条件
    strCriteria = "Item_ID = " & tbItemID.Value
    ' 文本类型替换为：
    ' strCriteria = "Item_ID = '" & Replace(tbItemID.Value, "'", "''") & "'"
    
    Set rs = CurrentDb.OpenRecordset("tblItems", dbOpenDynaset)
    rs.FindFirst strCriteria
    
    If rs.NoMatch Then
        MsgBox "记录已不存在，无法保存", vbInformation
    Else
        rs.Edit
        ' 更新表中字段值
        rs!Description = tbDesc.Value
        rs!UOM = cbUOM.Value
        rs!Cost = tbCost.Value
        rs.Update
        
        MsgBox "记录已成功更新", vbInformation
        ' 恢复表单初始状态
        tbItemID.Enabled = True
        lblDesc.Visible = False
        tbDesc.Visible = False
        lblUOM.Visible = False
        cbUOM.Visible = False
        lblCost.Visible = False
        tbCost.Visible = False
        
        ' 清空输入控件
        tbItemID.Value = ""
        tbDesc.Value = ""
        cbUOM.Value = ""
        tbCost.Value = ""
    End If
    
    rs.Close
    Set rs = Nothing
End Sub

额外优化建议 #

为避免SQL注入风险（尤其是文本类型字段），推荐使用参数化查询替代字符串拼接：

' 参数化查询示例（查找场景）
Dim qdf As QueryDef
Set qdf = CurrentDb.CreateQueryDef("", "SELECT * FROM tblItems WHERE Item_ID = ?")
qdf.Parameters(0) = tbItemID.Value
Set rs = qdf.OpenRecordset(dbOpenDynaset)

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