如何通过VBA（Recordset）编辑Access多值Lookup字段

问题描述 #

我用MS Access制作排班系统，表格采用多值Lookup字段选择当日值班员工。现在需要创建辅助按钮实现批量添加员工（例如为某员工安排整周班次），需编辑该多值字段以实现添加员工至现有选中列表或覆盖原有选中值的功能。但直接通过Recordset插入存储格式的字符串（如“1; 3; 6”）无法生效，附上相关VBA代码寻求解决办法。

原VBA代码 #

Private Sub btn_apply_Click()

Dim rs As DAO.Recordset
Dim Apotheke As String
Dim Schicht As String
Dim startdatum As Date
Dim enddatuma As Date
Dim strMitarbeiter As String

If Nz(Me.txt_von, "") = "" Or Nz(Me.txt_bis, "") = "" Or Nz(Me.comb_apotheke, "") = "" Or Nz(Me.comb_schicht, "") = "" Or Nz(Me.list_ma.Selected(1), "") = "" Then
    MsgBox "请先填写所有必填字段！"
    Exit Sub
End If

result = MsgBox("这将修改排班表！此操作不可撤销！继续？", vbYesNo, "警告！")
If result = vbNo Then Exit Sub

Apotheke = Me.comb_apotheke
Schicht = Me.comb_schicht
startdatum = Me.txt_createfrom
enddatum = Me.txt_createtill

For Each ma In Me.list_ma.ItemsSelected
    If strMitarbeiter = "" Then
        strMitarbeiter = ma
    Else
        strMitarbeiter = strMitarbeiter & ", " & ma
    End If
Next

Set rs = CurrentDb.OpenRecordset("select * from TBL_Schichten where [Standort] ='" & _
Apotheke & "' and [Schicht] ='" & Schicht & "' and [Abgerechnet] = FALSE order by " & _
"[Datum] ASC")

Do Until rs![Datum] = startdatum
    rs.MoveNext
Loop

Do Until rs![Datum] > enddatum
    rs.Edit
    rs![Mitarbeiter] = strMitarbeiter
    rs.Update
    rs.MoveNext
Loop

MsgBox "完成！"
End Sub

解决方案 #

核心问题 #

Access的多值字段本质是隐藏的关联子表，直接赋值字符串无法被系统识别，必须通过Recordset2对象操作多值字段的子记录集。

1. 实现覆盖原有选中值 #

将原代码中编辑rs![Mitarbeiter]的循环部分替换为以下代码：

Do Until rs![Datum] > enddatum
    rs.Edit
    ' 清空当前记录的所有原有值班员工
    Do While Not rs![Mitarbeiter].Value.EOF
        rs![Mitarbeiter].Value.Delete
        rs![Mitarbeiter].Value.MoveNext
    Loop
    ' 批量添加选中的员工ID
    For Each ma In Me.list_ma.ItemsSelected
        rs![Mitarbeiter].Value.AddNew
        rs![Mitarbeiter].Value(0) = ma ' 0对应多值字段绑定的员工表主键列
        rs![Mitarbeiter].Value.Update
    Next
    rs.Update
    rs.MoveNext
Loop

2. 实现添加员工至现有列表 #

如果需要保留原有值班员工，仅追加新选中的员工，去掉清空逻辑，新增重复检查避免重复添加：

Do Until rs![Datum] > enddatum
    rs.Edit
    ' 遍历选中的员工，添加至现有列表（去重）
    For Each ma In Me.list_ma.ItemsSelected
        Dim isExists As Boolean
        isExists = False
        ' 检查当前记录是否已包含该员工
        rs![Mitarbeiter].Value.MoveFirst
        Do While Not rs![Mitarbeiter].Value.EOF
            If rs![Mitarbeiter].Value(0) = ma Then
                isExists = True
                Exit Do
            End If
            rs![Mitarbeiter].Value.MoveNext
        Loop
        ' 未存在则添加
        If Not isExists Then
            rs![Mitarbeiter].Value.AddNew
            rs![Mitarbeiter].Value(0) = ma
            rs![Mitarbeiter].Value.Update
        End If
    Next
    rs.Update
    rs.MoveNext
Loop

额外优化建议 #

• 确保ma变量获取的是员工表的主键值（多值字段绑定的必须是主键，而非显示的姓名）
• 替换原SQL拼接逻辑为参数查询，避免SQL注入风险：

  Dim qdf As DAO.QueryDef
  Set qdf = CurrentDb.CreateQueryDef("", _
      "select * from TBL_Schichten where [Standort] = ? and [Schicht] = ? and [Abgerechnet] = FALSE order by [Datum] ASC")
  qdf.Parameters(0) = Apotheke
  qdf.Parameters(1) = Schicht
  Set rs = qdf.OpenRecordset
  

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