Access表单列表框AfterUpdate事件变量串扰问题求助

场景与问题 #

我有一个包含多个列表框和关联文本框的Access表单，逻辑是：选择列表框名称后触发AfterUpdate事件，查询数据库判断Eng_ID与Person_ID是否已存在于表中。存在则删除该行并插入更新记录，不存在则直接插入。

但切换列表框时，DLookup会错误使用前一个列表框的Person_ID，导致误删前一个列表框对应的记录，再插入新选择的记录。

现有代码 #

' Add/Remove Participant 1
Private Sub lstPar1_AfterUpdate()
    Dim n As Integer
    Dim strCriteria As String
    Dim strSQL As String
        
     With Me.lstPar1
        For n = .ListCount - 1 To 0 Step -1
            strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n)
                If .Selected(n) = False Then
                ' If a person has been deselected, then delete row from table
                If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
                    strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
                    CurrentDb.Execute strSQL, dbFailOnError
                    
                End If
                Else
                ' If a person has been selected, then insert row into the table
                If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
                   strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role)" & "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 1 & ",'" & Me.txtParRole1.Value & "' )"
                    CurrentDb.Execute strSQL, dbFailOnError
                End If
            End If
        Next n
    End With
    
End Sub

' Add/Remove Participant 2

Private Sub lstPar2_AfterUpdate()
    Dim n As Integer
    Dim strCriteria As String
    Dim strSQL As String
    
    With Me.lstPar2
     For n = .ListCount - 1 To 0 Step -1
            strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n)
                If .Selected(n) = False Then
                ' If a person has been deselected, then delete row from table
                If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
                    strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
                    CurrentDb.Execute strSQL, dbFailOnError
                End If
                Else
                ' If a person has been selected, then insert row into the table
                If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
                    strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role) " & "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 2 & ",'" & Me.txtParRole2.Value & "' )"
                    CurrentDb.Execute strSQL, dbFailOnError
                End If
            End If
        Next n
    End With
End Sub

示例场景 #

选择Daniel并输入角色后，数据库录入记录：Eng_ID=130、Person_ID=118、ParticipantNumber=1、Role=Collaborator；再选择Kristin时，系统错误使用Person_ID=118删除Daniel的记录，随后添加Kristin的记录。

解决方案 #

问题出在判断条件不完整：当前仅用Eng_ID和Person_ID作为判断依据，但同一个Person_ID可能对应不同的ParticipantNumber（比如参与者1和参与者2）。需要把ParticipantNumber也加入查询条件，确保只处理当前列表框对应的参与者记录。

修改后的lstPar1_AfterUpdate事件 #

' Add/Remove Participant 1
Private Sub lstPar1_AfterUpdate()
    Dim n As Integer
    Dim strCriteria As String
    Dim strSQL As String
        
     With Me.lstPar1
        For n = .ListCount - 1 To 0 Step -1
            ' 加入ParticipantNumber=1作为条件，限定只处理参与者1的记录
            strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n) & " And ParticipantNumber = 1"
                If .Selected(n) = False Then
                ' 删除对应参与者1的记录
                If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
                    strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
                    CurrentDb.Execute strSQL, dbFailOnError
                    
                End If
                Else
                ' 插入参与者1的记录
                If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
                   strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role)" & _
                            "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 1 & ",'" & Me.txtParRole1.Value & "' )"
                    CurrentDb.Execute strSQL, dbFailOnError
                End If
            End If
        Next n
    End With
    
End Sub

修改后的lstPar2_AfterUpdate事件 #

' Add/Remove Participant 2
Private Sub lstPar2_AfterUpdate()
    Dim n As Integer
    Dim strCriteria As String
    Dim strSQL As String
    
    With Me.lstPar2
     For n = .ListCount - 1 To 0 Step -1
            ' 加入ParticipantNumber=2作为条件，限定只处理参与者2的记录
            strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n) & " And ParticipantNumber = 2"
                If .Selected(n) = False Then
                ' 删除对应参与者2的记录
                If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
                    strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
                    CurrentDb.Execute strSQL, dbFailOnError
                End If
                Else
                ' 插入参与者2的记录
                If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
                    strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role) " & _
                             "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 2 & ",'" & Me.txtParRole2.Value & "' )"
                    CurrentDb.Execute strSQL, dbFailOnError
                End If
            End If
        Next n
    End With
End Sub

额外优化建议 #

• 避免直接拼接SQL字符串，防止SQL注入风险，可使用参数化查询：

  ' 示例：参数化插入
  Dim qdf As QueryDef
  Set qdf = CurrentDb.CreateQueryDef("", _
      "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role) VALUES (@EngID, @PersonID, @PartNum, @Role)")
  qdf.Parameters("@EngID") = Me.Eng_ID
  qdf.Parameters("@PersonID") = .ItemData(n)
  qdf.Parameters("@PartNum") = 1
  qdf.Parameters("@Role") = Me.txtParRole1.Value
  qdf.Execute dbFailOnError
  Set qdf = Nothing
  

• 将重复逻辑封装成通用函数，减少代码冗余，比如创建一个UpdateParticipant函数，接收列表框控件、参与者编号、角色文本框作为参数。

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