Access绑定外键表的表单插入新记录后不显示问题排查

我有一个绑定了带外键表的Access表单，表单内有一个框架控件，它的After_Update事件会触发ADODB命令，向表中插入一条携带相同外键值（lngSlctdEntrantID）的新记录，同时为其他几个字段赋值。表中唯一必填字段是AutoIncrement类型的自增主键。
代码后续会设置筛选，展示所有关联该外键值的记录，正常预期是2条：表单原本显示的现有分配记录、新分配对应的新记录。代码执行流程完全符合预期，但新记录不会在表单上展示，已尝试以下操作：

• 命令执行完成后重置筛选
• 对表单执行Requery操作（也尝试过Refresh和Repaint，按逻辑Requery是正确选择）
• 检查ADODB命令的状态
• 通过限制为新ID值的ADODB记录集检查新记录是否存在

框架控件代码 #

Private Sub fraCoachOrMentor_AfterUpdate()

    On Error GoTo Err_fCOM_AU

    Dim intCoachMentor As Integer
    Dim strSlctdStaff As String
    Dim strEntrantName As String
    Dim lngSlctdEntrantID As Long
    Dim lngLifeCoachAssigneeID As Long
    Dim cnnMain As ADODB.Connection
    Dim sqlChk As String
    Dim sqlChkNewTrsfr As String
    Dim rstChk As ADODB.Recordset
    Dim dteAssign As Date
    Dim sqlAdd As String
    Dim sqlUpdate As String
    Dim cmdAddUpdate As ADODB.Command
    Dim lngNewAssignedID As Long
    Dim strFilter As String
    Dim strAddForm As String
    Dim strThisForm As String
    Dim intChk As Integer

    intChk = 0

    intCoachMentor = fraCoachOrMentor

    cboLifeCoach.Visible = False
    txtLifeCoachName.Visible = False
    cboMentor.Visible = False
    txtMentorName.Visible = False
    Me.Section(0).Visible = False
    intChk = 1
    
    lblHlpAction.Visible = True
    
    If intCoachMentor = 1 Then
        cboLifeCoach.Visible = True
        txtLifeCoachName.Visible = True
        lblCrntCoachMentor.Caption = "Life Coach"
        lblTrnsfrReason.Caption = "Life Coach Transfer Reason"
        lblHlpAction.Caption = "Select a new Life Coach for this Resident and enter a reason for the transfer"
    ElseIf intCoachMentor = 2 Then
        cboMentor.Visible = True
        txtMentorName.Visible = True
        lblCrntCoachMentor.Caption = "Mentor"
        lblTrnsfrReason.Caption = "Mentor Transfer Reason"
        lblHlpAction.Caption = "Select a new Mentor for this Resident and enter a reason for the transfer"
    End If
    intChk = 2

    lngSlctdEntrantID = cboSlctResident
    dteAssign = CDate(Int(Now()))
    Me.Section(0).Visible = True
    intChk = 3
    
    strFilter = "[EntrantID] = " & lngSlctdEntrantID & " And (IsNull([AssignStop]) Or [AssignStop] >= #" & dteAssign & "#)"

    Me.Filter = strFilter
    Me.FilterOn = True
    intChk = 4
    
    If intCoachMentor = 1 Then
        sqlChkNewTrsfr = "SELECT LifeCoachAssigneeID, EntrantID, AssignStart, MntrPersonID, LCPersonID " _
            & "FROM LifeCoachAssignees WHERE (((EntrantID)=" & lngSlctdEntrantID & ") AND " _
            & "(((AssignStart)>=#" & dteAssign & "#) AND ((LCPersonID)>0)));"
        sqlChk = "SELECT LifeCoachAssigneeID, EntrantID, AssignStart, MntrPersonID, LCPersonID " _
            & "FROM LifeCoachAssignees WHERE (((EntrantID)=" & lngSlctdEntrantID & ") AND ((LCPersonID)>0));"
            strSlctdStaff = "Life Coach"
    ElseIf intCoachMentor = 2 Then
        sqlChkNewTrsfr = "SELECT LifeCoachAssigneeID, EntrantID, AssignStart, MntrPersonID, LCPersonID " _
            & "FROM LifeCoachAssignees WHERE (((EntrantID)=" & lngSlctdEntrantID & ") AND " _
            & "(((AssignStart)>=#" & dteAssign & "#) AND ((MntrPersonID)>0)));"
        sqlChk = "SELECT LifeCoachAssigneeID, EntrantID, AssignStart, MntrPersonID, LCPersonID " _
            & "FROM LifeCoachAssignees WHERE (((EntrantID)=" & lngSlctdEntrantID & ") AND ((MntrPersonID)>0));"
            strSlctdStaff = "Mentor"
    End If
    intChk = 5

    Set cnnMain = New ADODB.Connection
    cnnMain.ConnectionString = cnstCnctMain
    cnnMain.Open
    intChk = 6

    Set rstChk = New ADODB.Recordset
    rstChk.Open sqlChkNewTrsfr, cnnMain, adOpenKeyset
    If rstChk.RecordCount > 0 Then
        MsgBox "A new transfer effective today has already been added for " & strSlctdStaff & " for " & strEntrantName & "." & Chr(13) _
        & "Both the new assignment as well as the previous (if there was a previous assignment for " & strSlctdStaff & ") is now displayed.", vbOKOnly, "Today's New Transfer"
        rstChk.Close
        GoTo DisplayNewTransfer
    Else
        rstChk.Close
    End If
    intChk = 7

    Set rstChk = New ADODB.Recordset
    rstChk.Open sqlChk, cnnMain, adOpenKeyset
    If rstChk.RecordCount = 0 Then
        MsgBox "This Resident, " & strEntrantName & ", has not been assigned a " & strSlctdStaff & " yet." & Chr(13) _
        & "The system will now open the screen for adding a new assignment for " & strEntrantName & ".", vbOKOnly, "Resident Without Assignment"
        rstChk.Close
        strAddForm = "frmHouseAssign"
        strThisForm = Me.Name
        Application.Echo False
        If strAddForm <> "" And CurrentProject.AllForms(strAddForm).IsLoaded = False Then
            DoCmd.OpenForm strAddForm
        End If
        DoCmd.Close acForm, strThisForm
        Application.Echo True
        GoTo Exit_fCOM_AU
    Else
        rstChk.Close
    End If
    intChk = 8

    lngLifeCoachAssigneeID = [LifeCoachAssigneeID]
    txtOriginalRcrd = lngLifeCoachAssigneeID
    strEntrantName = cboSlctResident.Column(1)
    intChk = 9

    sqlAdd = "INSERT INTO LifeCoachAssignees ( EntrantID, AssignStart, StartWasTransfer, IsCurrent, Added, AddedByID ) " _
        & "SELECT " & lngSlctdEntrantID & " AS EntrantID, #" & Now() & "# AS AssignStart, -1 AS StartWasTransfer, " _
        & "-1 AS IsCurrent, #" & Now() & "# AS Added, " & lngLogeeID & " AS AddedByID;"

    Set cmdAddUpdate = New ADODB.Command
    cmdAddUpdate.CommandText = sqlAdd
    cmdAddUpdate.ActiveConnection = cnnMain
    cmdAddUpdate.Execute
    Set cmdAddUpdate = Nothing
    intChk = 10
    DoCmd.RunCommand acCmdSaveRecord
    lngNewAssignedID = DMax("LifeCoachAssigneeID", "LifeCoachAssignees")

    sqlUpdate = "UPDATE LifeCoachAssignees SET AssignStop = #" & dteAssign & "#, StopWasTransfer = -1 " _
        & "WHERE (((LifeCoachAssigneeID)=" & lngLifeCoachAssigneeID & "));"

    Set cmdAddUpdate = New ADODB.Command
    cmdAddUpdate.CommandText = sqlUpdate
    cmdAddUpdate.ActiveConnection = cnnMain
    cmdAddUpdate.Execute
    Set cmdAddUpdate = Nothing
    intChk = 11
    DoCmd.RunCommand acCmdSaveRecord

    sqlChk = "SELECT EntrantID FROM LifeCoachAssignees WHERE (((LifeCoachAssigneeID) = " & lngNewAssignedID & "));"
    Set rstChk = New ADODB.Recordset
    rstChk.Open sqlChk, cnnMain, adOpenKeyset

ChkAgain:
    If rstChk.RecordCount = 0 Then
        GoTo ChkAgain
    End If
    rstChk.Close

    Me.Requery

DisplayNewTransfer:

    Application.Echo False
    Me.Filter = ""
    Me.FilterOn = False
    intChk = 12

    strFilter = "[EntrantID] = " & lngSlctdEntrantID & " And (IsNull([AssignStop]) Or [AssignStop] >= #" & dteAssign & "#)"

    Me.Filter = strFilter
    Me.FilterOn = True

    Application.Echo True
    intChk = 13



Exit_fCOM_AU:
    cnnMain.Close
    Set cnnMain = Nothing
    Exit Sub
    
    
Err_fCOM_AU:
    MsgBox "Error coming from Coach or Mentor After Update at " & intChk & ". Err # " & Err.Number & " - " & Err.Description
    Resume Exit_fCOM_AU

End Sub

修复方案 #

核心问题原因 #

当前插入新记录的SQL语句缺失了类型对应的人员ID字段赋值：如果选择的是LifeCoach，需要给LCPersonID字段赋值为下拉框cboLifeCoach选中的ID；如果选择的是Mentor，需要给MntrPersonID字段赋值为下拉框cboMentor选中的ID。如果表单的记录源默认过滤这两个字段不为空，新插入的记录因为这两个字段为空，自然不会被加载到表单中，即使执行Requery也看不到。

具体修复步骤 #

1. 修改INSERT语句，补充对应人员ID字段
   根据选中的分配类型，在INSERT的字段列表和值列表中增加对应字段：

If intCoachMentor = 1 Then
    sqlAdd = "INSERT INTO LifeCoachAssignees ( EntrantID, AssignStart, StartWasTransfer, IsCurrent, Added, AddedByID, LCPersonID ) " _
        & "VALUES (" & lngSlctdEntrantID & ", #" & Now() & "#, -1, -1, #" & Now() & "#, " & lngLogeeID & ", " & cboLifeCoach.Value & ");"
Else
    sqlAdd = "INSERT INTO LifeCoachAssignees ( EntrantID, AssignStart, StartWasTransfer, IsCurrent, Added, AddedByID, MntrPersonID ) " _
        & "VALUES (" & lngSlctdEntrantID & ", #" & Now() & "#, -1, -1, #" & Now() & "#, " & lngLogeeID & ", " & cboMentor.Value & ");"
End If

2. 移除多余的DoCmd.RunCommand acCmdSaveRecord语句
   该语句用于保存表单当前绑定的记录，和你通过ADODB直接插入的新记录无关，多余的调用可能导致意外保存脏数据。
3. Requery后显式定位到新记录
   在Me.Requery后增加以下代码，方便直接跳转到新插入的记录：

With Me.RecordsetClone
    .FindFirst "LifeCoachAssigneeID = " & lngNewAssignedID
    If Not .NoMatch Then
        Me.Bookmark = .Bookmark
    End If
End With

4. 确认表单记录源无额外隐藏过滤条件，确保新插入的记录符合查询规则。

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