子表单不更新动态添加的新数据
Subform doesn't update with new data added on the fly
如果在表单打开时添加数据（通过追加查询），我很难让子表单显示最新数据。
与问题相关的 tables/forms/VBA & SQL 的快速解释：
我有三个 table 记录我部门内的团队、团队中可用的工作角色以及每个角色可用的职位总数。
table 是：
- 团队：TeamID (AutoNum, PK), TeamName (Text), CostCode (正文)
- 角色: RoleID (AutoNum, PK), RoleDesc (Text), Abbrev (正文)
- Team_Composition: TeamID (Num, PK), RoleID (Num, PK), RoleCount (Num)
表格如下，TeamID linking Master/Child 字段：
主窗体的 RecordSource 是 Teams table.
子表单的 RecordSource 是一个查询，它允许用户在 RoleCount 字段中为每个团队中的每个角色输入所需的数字：
SELECT Team_Composition.TeamID
, Roles.RoleDesc
, Roles.Abbrev
, Team_Composition.RoleCount
FROM Team_Composition INNER JOIN Roles ON Team_Composition.RoleID = Roles.RoleID
WHERE Team_Composition.TeamID=[Forms]![Edit_Teams]![cmbTeamName]
主窗体上的团队名称组合框从团队 table 获取数据，并添加 < 新团队 > 作为列表中的第一项（SingleRecord table 就是 - 具有 1 个字段和 1 个记录的 table，因此 SELECT 将起作用）：
SELECT DISTINCT 0 AS TeamID
, '<New Team>' AS TeamName
FROM SingleRecord
UNION ALL SELECT TeamID
, TeamName
FROM Teams
ORDER BY TeamName
当打开表单时所有内容都已存在时，这一切都非常有效。我可以更改组合框中的值，然后触发 VBA 代码以移动到该记录并在子窗体中显示 linked 数据。然后我可以添加每个团队的总数。
移动到正确记录的代码如下：
'----------------------------------------------------------------------------------
' Procedure : cmbTeamName_AfterUpdate
' Author : Darren Bartrup-Cook
' Date : 12/06/2017
' Purpose : Keeps the details on the form in sync with the team selected in the combo box.
' Ensures all teams have all roles available to them by updating the team_composition
' table with new roles whenever the team is selected.
'-----------------------------------------------------------------------------------
Private Sub cmbTeamName_AfterUpdate()
'The first item in cmbTeamName is <New Team> which will not exist in the recordset.
'To avoid FindFirst going to the wrong record an attempt is made to create a new record
'allowing the form to filter to a non-existant record.
If cmbTeamName = 0 Then
DoCmd.GoToRecord , , acNewRec
Else
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
rs.FindFirst "[TeamID]=" & cmbTeamName
If Not (rs.BOF And rs.EOF) Then
Me.Recordset.Bookmark = rs.Bookmark
End If
rs.Close
Set rs = Nothing
If cmbTeamName <> 0 Then
Update_TeamComposition cmbTeamName.Column(1)
End If
End If
End Sub
Update_TeamComposition 过程执行 SQL 语句以确保团队拥有最新的可用角色列表：
Private Sub Update_TeamComposition(TeamName As String)
With DoCmd
.SetWarnings False
.RunSQL "INSERT INTO Team_Composition(TeamID, RoleID) " & _
"SELECT TeamID, RoleID " & _
"FROM Teams, Roles " & _
"WHERE TeamID = (SELECT TeamID FROM Teams WHERE TeamName='" & TeamName & "')"
.SetWarnings True
End With
End Sub
现在是问题代码（或者至少是我认为问题所在的地方）：
当一个新团队被添加到组合框时，它被插入到 Teams table 并且各种角色也被添加到 Team_Compositiontable。这有效 - 我可以打开 table 并查看其中的记录，但子表单拒绝更新和显示新记录。数据库 ID 显示 1。表单底部的记录计数显示记录 1 of 6，即使这是我添加的第 7 条记录 - Teams table 显示 7 条记录， Team_Composition table 显示角色已添加到团队 ID 7。
添加新队伍的VBA如下：
Private Sub cmbTeamName_NotInList(NewData As String, Response As Integer)
With DoCmd
.SetWarnings False
If cmbTeamName.OldValue = 0 Then
'A new team needs adding to the Team table.
.RunSQL "INSERT INTO Teams(TeamName) VALUES ('" & NewData & "')"
Response = acDataErrAdded
'The job roles for the team are inserted.
Update_TeamComposition NewData
Else
.RunSQL "UPDATE Teams SET TeamName = '" & NewData & "'" & _
"WHERE TeamID = " & cmbTeamName.Column(0)
Response = acDataErrAdded
End If
.SetWarnings True
End With
End Sub
我尝试在 Else 语句之前添加代码来刷新表单 - Me.Refresh、Me.Requery、Me.Repaint。
Me.Requery 和 Me.Refresh 导致 NotInList 代码多次 运行 并最终给出 run-time 2237 - The text you entered isn't an item in the list（在 Me. 行）。
Me.Repaint 似乎什么也没做。
我想我已经包含了所有内容 - 有谁知道在添加新团队时如何让子表单填充角色？在我看来，table 索引似乎没有更新，并且表单无法识别已创建的新记录。
编辑：
在 @June7 的建议下，我将 NotInList 代码更新为：
Private Sub cmbTeamName_NotInList(NewData As String, Response As Integer)
With DoCmd
.SetWarnings False
If Me.cmbTeamName.OldValue = 0 Then
'A new team needs adding to the Team table.
.RunSQL "INSERT INTO Teams(TeamName) VALUES ('" & NewData & "')"
Response = acDataErrAdded
'The job roles for the team are inserted.
Update_TeamComposition NewData
'To stop the Requery from making NotInList fire multiple times
'the combo box is moved to a team that does exist before the requery.
'Then it can move to the new record.
Me.cmbTeamName = Me.cmbTeamName.ItemData(0)
Me.Requery
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
rs.FindFirst "[TeamName]='" & NewData & "'"
Me.Recordset.Bookmark = rs.Bookmark
rs.Close
Set rs = Nothing
Me.cmbTeamName.Requery
Me.cmbTeamName = CLng(Me.txtTeamID)
Else
.RunSQL "UPDATE Teams SET TeamName = '" & NewData & "'" & _
"WHERE TeamID = " & Me.cmbTeamName.OldValue
Response = acDataErrAdded
End If
.SetWarnings True
End With
End Sub
我还更新了子表单的 SQL，删除了 WHERE 子句，允许表单使用 Master/Child link.
如果不利用 form/subform 的 Master/Child 链接，为什么要绑定主窗体？子窗体 RecordSource 具有引用组合框的筛选条件。那么，如果组合框的 TeamID 为 0，则不存在关联的 Team_Composition 记录。建议您使用子表单容器的 Master/Child 链接属性，而不是查询中的动态过滤器参数。我从不使用动态参数化查询。
将新记录添加到两个 table 后，重新查询主窗体（同时也应该重新查询子窗体）。但是，由于重新查询集中在第一条记录上，还需要移动到刚刚在主窗体上创建的记录（如果按 TeamID 排序，则在最后）或将排序顺序设置为 TeamID DESCENDING 或使用 RecordsetClone 和 Bookmark 代码。
可以在没有 SingleRecord 的组合框 RowSource UNION 查询中创建 行 table。
SELECT 0 As TeamID, "<New Team>" AS TeamName FROM Teams
UNION SELECT TeamID, TeamName FROM Teams ORDER BY TeamName;
如果源 table 没有记录（如首次部署数据库时），组合框列表将为空。解决方法是使用另一个保证有记录的 table（系统 table 可以工作，我使用 MSysObjects）作为虚拟项的来源。
SELECT 0 As TeamID, "<New Team>" AS TeamName FROM MSysObjects
UNION SELECT TeamID, TeamName FROM Teams ORDER BY TeamName;
如果在表单打开时添加数据（通过追加查询），我很难让子表单显示最新数据。
与问题相关的 tables/forms/VBA & SQL 的快速解释：
我有三个 table 记录我部门内的团队、团队中可用的工作角色以及每个角色可用的职位总数。
table 是：
- 团队：TeamID (AutoNum, PK), TeamName (Text), CostCode (正文)
- 角色: RoleID (AutoNum, PK), RoleDesc (Text), Abbrev (正文)
- Team_Composition: TeamID (Num, PK), RoleID (Num, PK), RoleCount (Num)
表格如下，TeamID linking Master/Child 字段：
主窗体的 RecordSource 是 Teams table.
子表单的 RecordSource 是一个查询，它允许用户在 RoleCount 字段中为每个团队中的每个角色输入所需的数字：
SELECT Team_Composition.TeamID
, Roles.RoleDesc
, Roles.Abbrev
, Team_Composition.RoleCount
FROM Team_Composition INNER JOIN Roles ON Team_Composition.RoleID = Roles.RoleID
WHERE Team_Composition.TeamID=[Forms]![Edit_Teams]![cmbTeamName]
主窗体上的团队名称组合框从团队 table 获取数据，并添加 < 新团队 > 作为列表中的第一项（SingleRecord table 就是 - 具有 1 个字段和 1 个记录的 table，因此 SELECT 将起作用）：
SELECT DISTINCT 0 AS TeamID
, '<New Team>' AS TeamName
FROM SingleRecord
UNION ALL SELECT TeamID
, TeamName
FROM Teams
ORDER BY TeamName
当打开表单时所有内容都已存在时，这一切都非常有效。我可以更改组合框中的值，然后触发 VBA 代码以移动到该记录并在子窗体中显示 linked 数据。然后我可以添加每个团队的总数。
移动到正确记录的代码如下：
'----------------------------------------------------------------------------------
' Procedure : cmbTeamName_AfterUpdate
' Author : Darren Bartrup-Cook
' Date : 12/06/2017
' Purpose : Keeps the details on the form in sync with the team selected in the combo box.
' Ensures all teams have all roles available to them by updating the team_composition
' table with new roles whenever the team is selected.
'-----------------------------------------------------------------------------------
Private Sub cmbTeamName_AfterUpdate()
'The first item in cmbTeamName is <New Team> which will not exist in the recordset.
'To avoid FindFirst going to the wrong record an attempt is made to create a new record
'allowing the form to filter to a non-existant record.
If cmbTeamName = 0 Then
DoCmd.GoToRecord , , acNewRec
Else
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
rs.FindFirst "[TeamID]=" & cmbTeamName
If Not (rs.BOF And rs.EOF) Then
Me.Recordset.Bookmark = rs.Bookmark
End If
rs.Close
Set rs = Nothing
If cmbTeamName <> 0 Then
Update_TeamComposition cmbTeamName.Column(1)
End If
End If
End Sub
Update_TeamComposition 过程执行 SQL 语句以确保团队拥有最新的可用角色列表：
Private Sub Update_TeamComposition(TeamName As String)
With DoCmd
.SetWarnings False
.RunSQL "INSERT INTO Team_Composition(TeamID, RoleID) " & _
"SELECT TeamID, RoleID " & _
"FROM Teams, Roles " & _
"WHERE TeamID = (SELECT TeamID FROM Teams WHERE TeamName='" & TeamName & "')"
.SetWarnings True
End With
End Sub
现在是问题代码（或者至少是我认为问题所在的地方）：
当一个新团队被添加到组合框时，它被插入到 Teams table 并且各种角色也被添加到 Team_Compositiontable。这有效 - 我可以打开 table 并查看其中的记录，但子表单拒绝更新和显示新记录。数据库 ID 显示 1。表单底部的记录计数显示记录 1 of 6，即使这是我添加的第 7 条记录 - Teams table 显示 7 条记录， Team_Composition table 显示角色已添加到团队 ID 7。
添加新队伍的VBA如下：
Private Sub cmbTeamName_NotInList(NewData As String, Response As Integer)
With DoCmd
.SetWarnings False
If cmbTeamName.OldValue = 0 Then
'A new team needs adding to the Team table.
.RunSQL "INSERT INTO Teams(TeamName) VALUES ('" & NewData & "')"
Response = acDataErrAdded
'The job roles for the team are inserted.
Update_TeamComposition NewData
Else
.RunSQL "UPDATE Teams SET TeamName = '" & NewData & "'" & _
"WHERE TeamID = " & cmbTeamName.Column(0)
Response = acDataErrAdded
End If
.SetWarnings True
End With
End Sub
我尝试在 Else 语句之前添加代码来刷新表单 - Me.Refresh、Me.Requery、Me.Repaint。
Me.Requery 和 Me.Refresh 导致 NotInList 代码多次 运行 并最终给出 run-time 2237 - The text you entered isn't an item in the list（在 Me. 行）。
Me.Repaint 似乎什么也没做。
我想我已经包含了所有内容 - 有谁知道在添加新团队时如何让子表单填充角色？在我看来，table 索引似乎没有更新，并且表单无法识别已创建的新记录。
编辑：
在 @June7 的建议下，我将 NotInList 代码更新为：
Private Sub cmbTeamName_NotInList(NewData As String, Response As Integer)
With DoCmd
.SetWarnings False
If Me.cmbTeamName.OldValue = 0 Then
'A new team needs adding to the Team table.
.RunSQL "INSERT INTO Teams(TeamName) VALUES ('" & NewData & "')"
Response = acDataErrAdded
'The job roles for the team are inserted.
Update_TeamComposition NewData
'To stop the Requery from making NotInList fire multiple times
'the combo box is moved to a team that does exist before the requery.
'Then it can move to the new record.
Me.cmbTeamName = Me.cmbTeamName.ItemData(0)
Me.Requery
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
rs.FindFirst "[TeamName]='" & NewData & "'"
Me.Recordset.Bookmark = rs.Bookmark
rs.Close
Set rs = Nothing
Me.cmbTeamName.Requery
Me.cmbTeamName = CLng(Me.txtTeamID)
Else
.RunSQL "UPDATE Teams SET TeamName = '" & NewData & "'" & _
"WHERE TeamID = " & Me.cmbTeamName.OldValue
Response = acDataErrAdded
End If
.SetWarnings True
End With
End Sub
我还更新了子表单的 SQL，删除了 WHERE 子句，允许表单使用 Master/Child link.
如果不利用 form/subform 的 Master/Child 链接，为什么要绑定主窗体？子窗体 RecordSource 具有引用组合框的筛选条件。那么，如果组合框的 TeamID 为 0，则不存在关联的 Team_Composition 记录。建议您使用子表单容器的 Master/Child 链接属性，而不是查询中的动态过滤器参数。我从不使用动态参数化查询。
将新记录添加到两个 table 后，重新查询主窗体（同时也应该重新查询子窗体）。但是，由于重新查询集中在第一条记录上，还需要移动到刚刚在主窗体上创建的记录（如果按 TeamID 排序，则在最后）或将排序顺序设置为 TeamID DESCENDING 或使用 RecordsetClone 和 Bookmark 代码。
可以在没有 SingleRecord 的组合框 RowSource UNION 查询中创建
SELECT 0 As TeamID, "<New Team>" AS TeamName FROM Teams
UNION SELECT TeamID, TeamName FROM Teams ORDER BY TeamName;
如果源 table 没有记录（如首次部署数据库时），组合框列表将为空。解决方法是使用另一个保证有记录的 table（系统 table 可以工作，我使用 MSysObjects）作为虚拟项的来源。
SELECT 0 As TeamID, "<New Team>" AS TeamName FROM MSysObjects
UNION SELECT TeamID, TeamName FROM Teams ORDER BY TeamName;