求助：使用VBA Recordset扫描条形码拉取头盔信息至Check In & Out表单

一、现有搜索按钮代码的问题修正 #

你的搜索按钮代码存在语法和逻辑问题，修正后的代码如下：

Private Sub Search_Button_Click()
    Dim rst As DAO.Recordset
    Dim strsql As String
    
    ' 校验空输入
    If Trim(txt.ScanUPCCode.Value) = "" Then
        MsgBox "请扫描或输入UPC码"
        txt.ScanUPCCode.SetFocus
        Exit Sub
    End If
    
    ' 修正SQL语法：带空格的字段名用方括号包裹，字符串值加单引号避免语法错误
    strsql = "SELECT * FROM Helmets WHERE [UPC Code] = '" & _
             Replace(txt.ScanUPCCode.Value, "'", "''") & "'"
    
    Set rst = CurrentDb.OpenRecordset(strsql)
    
    If rst.EOF And rst.BOF Then
        MsgBox "未找到对应头盔数据"
        ' 清空控件值（用空字符串而非Nothing，控件不支持直接赋值Nothing）
        txt.ScanUPCCode.Value = ""
        txt.HelmetID.Value = ""
        txt.School.Value = ""
    Else
        ' 修正Value拼写错误
        txt.HelmetID.Value = rst.Fields("HelmetIDNumber")
        txt.School.Value = rst.Fields("School")
        
        ' 可选：显示当前借还状态（需表中存在对应时间戳字段）
        If Not IsNull(rst.Fields("CheckOutTime")) And IsNull(rst.Fields("CheckInTime")) Then
            MsgBox "该头盔已借出，借出时间：" & rst.Fields("CheckOutTime")
        ElseIf Not IsNull(rst.Fields("CheckInTime")) Then
            MsgBox "该头盔已归还，归还时间：" & rst.Fields("CheckInTime")
        Else
            MsgBox "该头盔未被借出"
        End If
    End If
    
    rst.Close
    Set rst = Nothing
End Sub

修正点说明 #

• 增加空输入校验，避免无效SQL查询
• Access中带空格的字段名需用方括号[UPC Code]包裹
• UPC码为字符串类型，查询时需用单引号包裹，同时用Replace处理输入中的单引号，防止SQL注入错误
• 修正Vaule拼写错误为Value
• 清空控件时使用空字符串""，符合控件赋值规则
• 增加借还状态提示，需提前在Helmets表添加CheckOutTime和CheckInTime日期/时间类型字段

二、添加出库/归还时间戳功能 #

在表单中新增两个按钮（CheckOut_Button和CheckIn_Button），分别实现头盔借出和归还的时间戳记录：

1. 出库按钮代码 #

Private Sub CheckOut_Button_Click()
    Dim rst As DAO.Recordset
    Dim strsql As String
    
    If Trim(txt.HelmetID.Value) = "" Then
        MsgBox "请先扫描头盔UPC码获取信息"
        txt.ScanUPCCode.SetFocus
        Exit Sub
    End If
    
    strsql = "SELECT * FROM Helmets WHERE [HelmetIDNumber] = '" & _
             Replace(txt.HelmetID.Value, "'", "''") & "'"
    
    Set rst = CurrentDb.OpenRecordset(strsql, dbOpenDynaset)
    
    If Not (rst.EOF And rst.BOF) Then
        ' 检查是否已借出未归还
        If Not IsNull(rst.Fields("CheckOutTime")) And IsNull(rst.Fields("CheckInTime")) Then
            MsgBox "该头盔已借出，无法重复出库"
        Else
            ' 更新出库时间戳，清空归还时间
            rst.Edit
            rst.Fields("CheckOutTime") = Now()
            rst.Fields("CheckInTime") = Null
            rst.Update
            MsgBox "头盔出库成功，时间：" & Now()
        End If
    Else
        MsgBox "未找到对应头盔数据"
    End If
    
    rst.Close
    Set rst = Nothing
    
    ' 重新加载数据更新状态
    Search_Button_Click
End Sub

2. 归还按钮代码 #

Private Sub CheckIn_Button_Click()
    Dim rst As DAO.Recordset
    Dim strsql As String
    
    If Trim(txt.HelmetID.Value) = "" Then
        MsgBox "请先扫描头盔UPC码获取信息"
        txt.ScanUPCCode.SetFocus
        Exit Sub
    End If
    
    strsql = "SELECT * FROM Helmets WHERE [HelmetIDNumber] = '" & _
             Replace(txt.HelmetID.Value, "'", "''") & "'"
    
    Set rst = CurrentDb.OpenRecordset(strsql, dbOpenDynaset)
    
    If Not (rst.EOF And rst.BOF) Then
        ' 检查是否已借出且未归还
        If IsNull(rst.Fields("CheckOutTime")) Or Not IsNull(rst.Fields("CheckInTime")) Then
            MsgBox "该头盔未借出或已归还，无法执行归还操作"
        Else
            ' 更新归还时间戳
            rst.Edit
            rst.Fields("CheckInTime") = Now()
            rst.Update
            MsgBox "头盔归还成功，时间：" & Now()
        End If
    Else
        MsgBox "未找到对应头盔数据"
    End If
    
    rst.Close
    Set rst = Nothing
    
    ' 重新加载数据更新状态
    Search_Button_Click
End Sub

三、表结构建议 #

确保Helmets表包含以下核心字段（可根据实际需求扩展）：

• UPC Code：文本类型，存储头盔条形码
• HelmetIDNumber：文本/数字类型，头盔唯一标识ID
• School：文本类型，头盔所属学校
• CheckOutTime：日期/时间类型，记录出库时间
• CheckInTime：日期/时间类型，记录归还时间

内容的提问来源于stack exchange，提问作者Tiffani-Michelle Schmidt