子窗体不会随着动态添加的新数据而更新

Question

当表单打开时（通过附加查询）添加数据时，我很难找到子表单来显示最新数据。

快速解释与问题相关的表/表单/ VBA和SQL： 我有三个表来记录我部门内的团队，团队中可用的工作角色以及每个角色可用的职位总数。

表格是：

• 团队：TeamID（AutoNum，PK），TeamName（文本），CostCode（文本）
• 角色：RoleID（AutoNum，PK），RoleDesc（文本），缩写（文本）
• Team_Composition：TeamID（Num，PK），RoleID（Num，PK），RoleCount（Num）

表单如下，TeamID链接主/子字段：

主表单的RecordSource是Teams表。 子窗体的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]

主窗体上的Team Name组合框从Teams表中获取它的数据，并添加<New Team>作为列表中的第一项（SingleRecord表就是这样 - 一个包含1个字段和1个记录的表，因此SELECT将工作）：

SELECT DISTINCT     0 AS TeamID
                    , '<New Team>' AS TeamName 
FROM                SingleRecord  

UNION ALL SELECT    TeamID
                    , TeamName 
FROM                Teams 
ORDER BY            TeamName

当打开表单时已经存在所有内容时，这一切都很有效。我可以更改组合框中的值，并触发VBA代码移动到该记录并在子窗体中显示链接的数据。然后我可以为每个团队添加总数。

移动到正确记录的代码如下：

'----------------------------------------------------------------------------------
' 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表中，各种角色也会添加到Team_Composition表中。这有效 - 我可以打开表并查看其中的记录，但子表单拒绝更新并显示新记录。数据库ID显示1.表单底部的记录计数显示记录1 of 6，即使这是我添加的第7条记录 - Teams表显示7条记录，Team_Composition表显示角色已添加到Team 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.Requeryand Me.Refresh导致NotInList代码多次运行并最终给出run-time 2237 - The text you entered isn't an item in the list（在Me.线上）。 Me.Repaint似乎没有做任何事情。

我想我已经包含了所有内容 - 有人知道如何在添加新团队时让子窗体填充角色吗？对我而言，表格索引似乎没有更新，表单无法识别已创建的新记录。

编辑： 根据@ 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

我还通过删除WHERE子句来更新子窗体的SQL，允许表单使用主/子链接。

Answer 1

如果您不利用表单/子表单的主/子链接，为什么要绑定主表单？子表单RecordSource具有引用组合框的过滤条件。好吧，如果组合框的TeamID为0，则不存在关联的Team_Composition记录。建议您使用子窗体容器的主/子链接属性而不是查询中的动态过滤器参数。我永远不会使用动态参数化查询。

向两个表添加新记录后，请重新查询主窗体（还应同时重新查询子窗体）。但是，由于requery设置专注于第一个记录，因此还需要移动到刚在主窗体上创建的记录（最后如果按TeamID排序）或将排序顺序设置为TeamID DESCENDING或使用RecordsetClone和Bookmark代码。

可以在没有SingleRecord表的组合框RowSource UNION查询中创建<New Team>行。

SELECT 0 As TeamID, "<New Team>" AS TeamName FROM Teams
UNION SELECT TeamID, TeamName FROM Teams ORDER BY TeamName;

如果源表没有记录（如首次部署db时），则组合框列表将为空。解决方法是使用另一个保证有记录的表（系统表可以工作，我使用MSysObjects）作为虚拟项的源。

SELECT 0 As TeamID, "<New Team>" AS TeamName FROM MSysObjects
UNION SELECT TeamID, TeamName FROM Teams ORDER BY TeamName;