vba - 子表单不会随着动态添加的新数据而更新

Question

在表单打开时添加数据(通过追加查询)时，我很难让子表单显示最新数据。

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

表格是:

• 团队:团队 ID (AutoNum、PK)、团队名称 (文本)、成本代码 (文本)
• 角色: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]

主窗体上的团队名称组合框从 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 表显示角色已添加到团队 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似乎没有做任何事情。

我想我已经包含了所有内容 - 有谁知道当添加新团队时如何让子表单填充角色？对我来说，表索引似乎没有更新，并且表单无法识别已创建的新记录。

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

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

向两个表添加新记录后，重新查询主表单(同时也应重新查询子表单)。但是，由于重新查询集集中在第一条记录上，因此还需要移动到刚刚在主窗体上创建的记录(如果按 TeamID 排序则在最后)或将排序顺序设置为 TeamID DESCENDING 或使用 RecordsetClone和书签代码。

可以在组合框 RowSource UNION 查询中创建 行，而无需使用 SingleRecord 表。

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

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

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