访问 VBA - 使用书签删除过滤器并保留在当前记录

Access VBA - use Bookmark to remove filter and stay on current record

在 Access 2010 中,我有一个可以使用过滤器打开特定记录或记录的表单:

DoCmd.OpenForm "frmStories", , , "StoryID = " & someNumber  'open one record
DoCmd.OpenForm "frmStories", , , someCriteria               'open multiple records

使用下面的代码 (source) 可以让我 删除过滤器并保留在当前记录上 ... 我是这么想的。部分表单 - 即由 VBA 计算的字段 - 仍然认为它们在第一条记录上,使用 StoryID = 1,因此显示错误的结果。

Dim varFilterID As Variant

Public Sub Form_ApplyFilter(Cancel As Integer, ApplyType As Integer)
    
    'Note current record if filter is removed
    If ApplyType = acShowAllRecords Then
        varFilterID = Me.StoryID
    End If
    
End Sub

Private Sub Form_Current()        
    ' If the filter is OFF, and we have a stored ID from the filter setting,
    ' use standard bookmark code to return to the record selected for the filter.

    If Me.FilterOn = False Then
        If Nz(varFilterID) <> "" Then
            Dim rs As DAO.Recordset
            Set rs = Me.RecordsetClone
            rs.FindFirst = "StoryID = " & varFilterID
            Debug.Print "varFilterID=" & varFilterID & " storyID = " & Me.StoryID & " 1st"
            If rs.NoMatch = False Then Me.Bookmark = rs.Bookmark
            ' Reset the stored filterID so that the code does not keep forcing this
            ' selection as the user navigates through the records.
            varFilterID = Null
            Set rs = Nothing
            Debug.Print "varFilterID=" & varFilterID & " storyID = " & Me.StoryID & " 2nd"

        End If
    End If
    
    'other stuff    
End Sub

单步执行代码表明它第一次工作正常,到达子程序的末尾然后在再次触发 Form_Current 时重新启动(为什么?)此时 Me.StoryID 恢复为 1。这让我认为问题与 事件触发顺序 有关(ApplyFilter 似乎触发了 ''after'' Current已完成)。

翻页到上一条记录并返回修复它;当放在命令按钮中时,代码可以完美运行。

我做错了什么?或者,我可以采取另一种方法吗? (我需要过滤几个不连续的记录,所以用 .FindFirst 加载表单不是一个选项。)

ETA:我添加了一些 Print.Debug 行以查看发生了什么。这是结果:

ApplyType
varFilterID=35 storyID = 1 1st
varFilterID=35 storyID = 35 1st
varFilterID= storyID = 35 2nd
varFilterID= storyID = 1 2nd      <- resets between Current's End Sub and the last Current

编辑(5 年后):已解决!我在下面发布了我的解决方案。 Tl;博士 Exit Sub 是上帝。

我会在应用订单移除过滤器后尝试 Me.Refresh。

问题如下:If rs.NoMatch = False Then Me.Bookmark = rs.Bookmark 移动表单中的当前记录,触发另一个 Form_Current,可能会触发无限循环。

您可以尝试将 Form_Current 速率限制为每秒仅触发一次:

Private lastCurrent As Date
Private Sub Form_Current()
   If lastCurrent < Now() - #00:00:01# Then Exit Sub
   LastCurrent = Now()

请注意,根据代码执行 运行 所需的时间,您可能需要增加秒数。

不过请注意,这可能是一个 XY 问题。您可以通过以下方式在不应用过滤器的情况下打开表单时移动到特定记录

Dim frm As Form
Application.ScreenUpdating = False
DoCmd.OpenForm "frmStories"
Set frm = Forms!frmStories
Dim rs As RecordSet
Set rs = frm.RecordsetClone
strCriteria = "StoryID = " & someNumber
rs.FindFirst strCriteria
If rs.NoMatch = False Then frm.Bookmark = rs.Bookmark
Application.ScreenUpdating = True

实现此目的的其他技术可能是使用 OpenArgs,这是我经常使用的方法。

整整五年后,我终于(终于!)搞清楚了到底是怎么回事。正如埃里克所说,Me.Bookmark = rs.Bookmark 移动了记录,触发了另一个 Form_Current,导致了这种情况的发生:

  1. 应用过滤器,转到特定记录 (StoryID = 58),删除过滤器
  2. 表单转到第一条记录(StoryID = 1)。
  3. Form_Current 触发器。因为删除了过滤器,Nz(varFilterID) <> "" 所以记录集代码运行,直到...
  4. Me.Bookmark = rs.Bookmark
  5. 表单转到已添加书签的记录 (StoryID = 58) 并且 Form_Current 再次触发。它按预期跳过书签代码,并运行事件代码的其余部分,do stuff with StoryID
  6. 然后returns到第4步之后的那一行,完成运行原来的Form_Current(原来的StoryID = 1 ,所以 do stuff with StoryID 中的所有内容都计算错误)。

基本上,(旧 Form_Current [新 Form_Current] 其余旧 Form_Current)。 那么,解决方案就是在书签行之后简单地退出 sub:

Dim varFilterID As Variant

Public Sub Form_ApplyFilter(Cancel As Integer, ApplyType As Integer)    
    'Note current record if filter is removed
    If ApplyType = acShowAllRecords Then
        varFilterID = Me.StoryID
    End If    
End Sub

Private Sub Form_Current()        
    ' If the filter is OFF, and we have a stored ID from the filter setting,
    ' use standard bookmark code to return to the record selected for the filter.
    ' Reset varFilterID once it has been used.

    If Me.FilterOn = False Then
        If Nz(varFilterID) <> "" Then
            Dim rs As DAO.Recordset
            Set rs = Me.RecordsetClone
            rs.FindFirst "StoryID = " & varFilterID
            varFilterID = ""
            If rs.NoMatch = False Then 
                Me.Bookmark = rs.Bookmark
                Set rs = Nothing
                Exit Sub             'THIS WAS IT!
            End If
            Set rs = Nothing
        End If
    End If
    
    'do stuff with StoryID    
End Sub