访问VBA筛选器RecordCount未正确更新值

时间:2017-04-07 15:12:18

标签: vba ms-access filter record-count

我有一个表单,我已经构建了一个运行“after_update”的过滤器搜索。当过滤器没有记录时,表单失败并显示空白。为了解决这个问题,我发现有几个帖子建议添加“RecordCount”并使用“if”语句然后触发过滤器,如果它不是< 1或= 0。我的问题是,RecordCount的值似乎显示了上次运行过滤器选择的记录数,而不是当前过滤器。我已经尝试了几种方法来“重新查询”并在应用过滤器后更新RecordCount的值但是我不能让它更新,因为我打算使用它。

示例:

过滤器1:结果在14条记录中,debug.print recordcount显示1

过滤器2:22条记录中的结果,debug.print recordcount显示14

过滤器3:0记录中的结果,表单失败,debug.print记录计数显示22

代码:

Private Sub ApplyFilterBtn_Click()
On Error GoTo Err_ApplyFilterBtn_Click

Dim stFilter As String

stFilter = ""

If Nz(Me.FilterOwner, "") <> "" Then
    stFilter = stFilter & "[MachineOwner] = " & Me.FilterOwner & " AND "
End If

If Nz(Me.FilterType, "") <> "" Then
    stFilter = stFilter & "[MachineType] = " & Me.FilterType & " AND "
End If

If Nz(Me.FilterSubType, "") <> "" Then
    stFilter = stFilter & "[MachineSubType] = " & Me.FilterSubType & " AND "
End If

If Nz(Me.FilterMake, "") <> "" Then
    stFilter = stFilter & "[Make] Like '" & Me.FilterMake & "' AND "
End If

If Nz(Me.FilterModel, "") <> "" Then
    stFilter = stFilter & "[Model] Like '*" & Me.FilterModel & "*' AND "
End If

If Nz(Me.FilterSN, "") <> "" Then
    stFilter = stFilter & "[SN] Like '" & Me.FilterSN & "' AND "
End If

If Nz(Me.FilterStatus, "") <> "" Then
    stFilter = stFilter & "[NewStatus] = " & Me.FilterStatus & " AND "
End If



If stFilter <> "" Then
    stFilter = Left(stFilter, Len(stFilter) - 5) 'Remove the extra AND

'<<<<<<<Issue starts here<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    Me.Recordset.Clone

      Me.RecordsetClone.Filter = stFilter
        Me.RecordsetClone.MoveLast
'       Me.RecordsetClone.MoveNext  'Tried this - did not help
'        Me.RecordsetClone.Requery  'tried this - did not help

'        Me.Filter = stFilter    ' Tries this - did not help

        'debugging to see value of RecordCount
        Debug.Print stFilter
        Debug.Print Me.RecordsetClone.RecordCount

'>>>>>> Recordsetclone.RecordCount value not refreshing properly above, shows previously called filter record count

  If Me.RecordsetClone.RecordCount < 1 Then  ' no records, don't filter
        'If Not (Me.RecordsetClone.BOF And Me.RecordsetClone.EOF) Then  'work around attempt 2 - failed
        'If Me.NoMatch Then                                             'Work around Attempt 3 - failed
            RemoveFilterBtn_Click ' Call sub that Clears filter
            MsgBox "Filter Results in No records", vbOKOnly, "No Results"
        Else ' there are records, turn on filter
            Me.Filter = stFilter
            Me.FilterOn = True
        End If 'Me.RecordCount < 1
    Else
        Me.FilterOn = False
        RemoveFilterBtn_Click ' Clears filter
    End If 'stFilter <> ""

Exit_ApplyFilterBtn_Click:
        Exit Sub

Err_ApplyFilterBtn_Click:
        MsgBox Err.Description
        Resume Exit_ApplyFilterBtn_Click

End Sub


Private Sub RemoveFilterBtn_Click()
On Error GoTo Err_RemoveFilterBtn_Click

    'Sets Filter Field Values to Blank
    Me.FilterOwner = ""
    Me.FilterType = ""
    Me.FilterMake = ""
    Me.FilterModel = ""
    Me.FilterSN = ""
    Me.FilterStatus = ""
    Me.FilterSubType = ""

    'Removes Filter
    Me.Filter = ""
    Me.FilterOn = False

Exit_RemoveFilterBtn_Click:
    Exit Sub

Err_RemoveFilterBtn_Click:
    MsgBox Err.Description
    Resume Exit_RemoveFilterBtn_Click

End Sub

1 个答案:

答案 0 :(得分:0)

它更简单但你需要正确的语法:

Dim rst As DAO.Recordset
Dim rstFiltered As DAO.Recordset

Set rst = Me.RecordsetClone
rst.Filter = stFilter

Set rstFiltered = rst.OpenRecordset()
If rstFiltered.RecordCount > 0 Then

    ' Do stuff.

End If
rstFiltered.Close

Set rstFiltered = Nothing
Set rst = Nothing