ApplyFilter with VBA

[Leslie Isaacs]

Hello All

I have been trying to use the ApplyFilter action in a macro, but can't get
it to work. In any case I seem to be finding that it is often better to use
VBA rather than macros, so I was wondering whether there is an equivalent
VBA command to the ApplyFilter macro action.

I have a query [qry_show_p45s] that takes as its record source
[qry_showAll]. [qry_showAll] is the record source for a form
[frm_employees]. I simply want to be able to apply [qry_show_p45s] as a
filter on [frm_employees]. I realise that normally I would simply do
something like:

Me.Filter = "[this]=[that]"
Me.FilterOn = True

.... but [qry_show_p45s] is based on another query and a table, so the
"[this]=[that]" filter would involve a lot of DLookups etc. and would be
quite messy. Also, being the amateur that I am, I find the query design grid
much easier than writing VBA, and it is likely that I will want to amend the
criteria in [qry_show_p45s] quite regularly.

So, is there a way of using VBA to apply [qry_show_p45s] to [frm_employees]
(or should I persevere with the macro)?

Hope someone can help.
Many thanks
Leslie Isaacs

 

[Kipp Woodard]

There are a couple of approaches you might take.

You might simply view [qry_show_p45s] in SQL mode and copy the Where clause
to your VBA.

If [qry_show_p45s] is too dynamic, thus you would have to regularly update
your VBA code, then you might open the QueryDef and extract the where clause
from it.

Here is a function I wrote for you that can get the Where clause of any
query. Just put in a module, perhaps named modMain. Then use it in your
form's module, like:

Me.Filter = GetWhereClauseOfQuery("qry_show_p45s")
Me.FilterOn = True

=====================
Code snippet
=====================
Private Const MOD_NAME As String = "modMain"

Public Function GetWhereClauseOfQuery(QueryName As String) As String
Const PROC_NAME As String = "GetWhereClauseOfQuery"

Dim oQueryDef As QueryDef
Dim oDatabase As Database
Dim sWhereClause As String
Dim iPosition As Integer

On Error GoTo ErrorHandler

Set oDatabase = CurrentDb

For Each oQueryDef In oDatabase.QueryDefs
If oQueryDef.NAME = QueryName Then
iPosition = InStrRev(oQueryDef.SQL, "Where ")

If iPosition > 0 Then
sWhereClause = Mid(oQueryDef.SQL, iPosition + 7)
End If

Exit For
End If
Next

' Trim off "Group By "
iPosition = InStr(1, sWhereClause, "Group By ")
If iPosition > 0 Then
sWhereClause = Left(sWhereClause, iPosition - 1)
End If

' Trim Off "Order By "
iPosition = InStr(1, sWhereClause, "Order By ")
If iPosition > 0 Then
sWhereClause = Left(sWhereClause, iPosition - 1)
End If

' Trim off "Having "
iPosition = InStr(1, sWhereClause, "Having ")
If iPosition > 0 Then
sWhereClause = Left(sWhereClause, iPosition - 1)
End If

' Trim off CRLF
If Right(sWhereClause, 2) = vbCrLf Then
sWhereClause = Left(sWhereClause, Len(sWhereClause) - 2)
End If

' Trim off ";"
If Right(sWhereClause, 1) = ";" Then
sWhereClause = Left(sWhereClause, Len(sWhereClause) - 1)
End If

Cleanup:

GetWhereClauseOfQuery = sWhereClause

Set oDatabase = Nothing

Exit Function

ErrorHandler:
MsgBox "Error: " & Err.Number & ", " & Err.Description, , MOD_NAME & "."
& PROC_NAME

On Error Resume Next

GoTo Cleanup

End Function

=====================
End of Code snippet
=====================

Hello All

I have been trying to use the ApplyFilter action in a macro, but can't get
it to work. In any case I seem to be finding that it is often better to use
VBA rather than macros, so I was wondering whether there is an equivalent
VBA command to the ApplyFilter macro action.

I have a query [qry_show_p45s] that takes as its record source
[qry_showAll]. [qry_showAll] is the record source for a form
[frm_employees]. I simply want to be able to apply [qry_show_p45s] as a
filter on [frm_employees]. I realise that normally I would simply do
something like:

Me.Filter = "[this]=[that]"
Me.FilterOn = True

.... but [qry_show_p45s] is based on another query and a table, so the
"[this]=[that]" filter would involve a lot of DLookups etc. and would be
quite messy. Also, being the amateur that I am, I find the query design grid
much easier than writing VBA, and it is likely that I will want to amend the
criteria in [qry_show_p45s] quite regularly.

So, is there a way of using VBA to apply [qry_show_p45s] to [frm_employees]
(or should I persevere with the macro)?

Hope someone can help.
Many thanks
Leslie Isaacs

 

[Kipp Woodard]

Public Function GetWhereClauseOfQuery(QueryName As String) As String
Const PROC_NAME As String = "GetWhereClauseOfQuery"

Dim oQueryDef As QueryDef
Dim oDatabase As Database
Dim sWhereClause As String
Dim iPosition As Integer

On Error GoTo ErrorHandler

Set oDatabase = CurrentDb

' Get the QueryDef, error protected in case it does not exist.
On Error Resume Next
Set oQueryDef = oDatabase.QueryDefs(QueryName)
On Error GoTo ErrorHandler

' If the query does not exist...
If oQueryDef Is Nothing Then
GoTo Cleanup
End If

' Get the start of the Where clause.
iPosition = InStrRev(oQueryDef.SQL, "Where ")

' If there is a Where clause...
If iPosition > 0 Then
' Get all of the SQL after the "Where ".
sWhereClause = Mid(oQueryDef.SQL, iPosition + 7)
End If

' Trim off "Group By ", if present.
iPosition = InStr(1, sWhereClause, "Group By ")
If iPosition > 0 Then
sWhereClause = Left(sWhereClause, iPosition - 1)
End If

' Trim Off "Order By ", if present.
iPosition = InStr(1, sWhereClause, "Order By ")
If iPosition > 0 Then
sWhereClause = Left(sWhereClause, iPosition - 1)
End If

' Trim off "Having ", if present.
iPosition = InStr(1, sWhereClause, "Having ")
If iPosition > 0 Then
sWhereClause = Left(sWhereClause, iPosition - 1)
End If

' Trim off CRLF, if present.
If Right(sWhereClause, 2) = vbCrLf Then
sWhereClause = Left(sWhereClause, Len(sWhereClause) - 2)
End If

' Trim off ";", if present.
If Right(sWhereClause, 1) = ";" Then
sWhereClause = Left(sWhereClause, Len(sWhereClause) - 1)
End If

Cleanup:

GetWhereClauseOfQuery = sWhereClause

Set oDatabase = Nothing

Exit Function

ErrorHandler:
MsgBox "Error: " & Err.Number & ", " & Err.Description, , MOD_NAME & "."
& PROC_NAME

On Error Resume Next

GoTo Cleanup

End Function

 

[PayeDoc]

Kipp

Absolutely brilliant!
I did have to amend the initial Instr to look for a HAVING clause, because -
wouldn't you know it - my query didn't have a WHERE clause!

Hope you've seen my comment in this newsgroup under the subject "These
newsgroups": your help today is a geat example of what I was on about!!

Many thanks again
Les

 

[Kipp Woodard]

I'm glad it was helpful. Pass the beer!

Kipp

Absolutely brilliant!
I did have to amend the initial Instr to look for a HAVING clause, because -
wouldn't you know it - my query didn't have a WHERE clause!

Hope you've seen my comment in this newsgroup under the subject "These
newsgroups": your help today is a geat example of what I was on about!!

Many thanks again
Les