访问表单不显示新记录

Question

我有一个Access表单绑定到一个包含外键的表。表单有一个带有After_Update事件的框架控件，该事件激活一个ADODB命令，将具有相同外键值(lngSlctdEntrantID)的新记录插入到表中，并向其他几个字段添加值。(表中唯一必需的字段是Primary Key，它是一个AutoIncrement字段)。代码通过设置一个过滤器来显示与外键值相关联的所有记录(应该只有2条记录—现有分配的记录(表单可以正确显示)和新分配的新记录)。代码完全按照预期执行，但是新记录没有显示在表单上。我尝试了以下操作:

1. 命令执行后重置过滤器
2. 重新查询表单(也尝试刷新和重新绘制，虽然我认为重新查询是正确的选择)
3. 检查ADODB命令的状态
4. 检查新记录是否存在，ADODB记录集限制为新的ID值。

框架控件中使用的代码如下:

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

Answer 1

您可能会使用RecordsetClone表单的更新-像这样:

Dim Records As DAO.Recordset
Set Records = Me.RecordsetClone
lngNewAssignedID = DMax("LifeCoachAssigneeID", "LifeCoachAssignees")
' Add new record.
Records.AddNew
Records!EntrantID.Value = lngSlctdEntrantID
Records!AssignStart.Value = Now
Records!StartWasTransfer.Value = True
Records!IsCurrent.Value = True
Records!Added.Value = Now
Records!AddedByID.Value = lngLogeeID
Records.Update 
' Update current record.
Records.Bookmark = Me.Bookmark
Records.Edit
Records!AssignStop.Value = dteAssign
Records!StopWasTransfer.Value = True
Records.Update
Records.Close

这将自动并立即更新表单。