AutoRequery function works in 2003 but not 2007

[uwphotonut]

I am using 2007 with Windows XP Pro. My database is a music database. I have form with a subform. The purpose of the form is to display records in the subform that match the selections in the main form.

The main form has unbound listboxes for Music Category, Media Type, and 11 checkboxes to select a rating. There is also a field to display how many records match the current selection. Each of these runs RequerySubform() in the AfterUpdate event. By selecting the No Auto Requery check box you can turn the Auto Requery off of leave the Auto Requery check box selected to leave it turned on. There are four buttons on the form, Requery, Clear, View Record and Exit

In Access 2003 it work great. Everytime you made a selection in the main form the data in the subform would match the selection.

In 2007 however nothing works. The unbound listboxes will not allow multiple selections (Multi Select Property set to Simple). When the form is first opened if one selection is made the initial set of records in the subform is correct. If the selection is changed only one record is display but the number in the Matching Records field is correct.

Here is the code:

Option Compare Database
Option Explicit

Public Function RequerySubform()
' Comments : © 07/07/2001 F.W.Fisher, Jr
' Parameters:
' Returns :
' Modified : 11/22/2001 Add line continuation
' 07/17/2002 Add code to display number of matching records
'
' --------------------------------------------------

On Error GoTo PROC_ERR

Dim strCategorySQL As String
Dim strRatingsSQL As String
Dim strMediaTypeSQL As String
Dim strWhereSQL As String
Dim strFullSQL As String
Dim intNumberOfRecords As Integer

'-- If AutoRequery is set to True, or the Requery button was pressed,
'-- then re-create the Where clause for the recordsource of the subform

If Me!optAutoRequery Or Screen.ActiveControl.Name = "cmdRequery" Then

'-- Store all the criteria for the Where statement into variables.

strCategorySQL = IncludeCategories()
strMediaTypeSQL = IncludeMediaTypes()
strRatingsSQL = IncludeRatings()

'-- Store the initial Where statement with whatever is from the
' Category criteria.
strWhereSQL = "Where " & strCategorySQL

'--If a media type was passed back, then add it to the Where clause.
If Len(strMediaTypeSQL) <> 0 Then

'--If the Category criteria was already added,
' AND it with the Ratings criteria.

If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If

strWhereSQL = strWhereSQL & strMediaTypeSQL

End If
'-- If a rating was passed back, then add it to the Where clause.
If Len(strRatingsSQL) <> 0 Then

'-- If the Media Type criteria was already added,
' AND it with the Ratings criteria.

If strWhereSQL <> "Where " Then
strWhereSQL = strWhereSQL & " And "
End If

strWhereSQL = strWhereSQL & strRatingsSQL

End If

'-- If no criteria was chosen, make it so the subform will be blank.

If strWhereSQL = "Where " Then
strWhereSQL = "Where False;"
End If

'-- Create the new SQL String and Store it to the Recordsource.
If strWhereSQL = "Where False;" Then
strFullSQL = "Select * From tblMusicTitles " & strWhereSQL
Else
strFullSQL = "Select * From tblMusicTitles " & strWhereSQL & _
"Order By tblMusicTitles.MediaTitle"
End If

Me!frmMusicSearchQuery.Form.RecordSource = strFullSQL
Me.RecordSource = strFullSQL
Me.intNumberOfRecords = Me.RecordsetClone.recordCount

'-- Set the requery button to black.
Me!cmdRequery.ForeColor = 0
Else
'-- Set the requery button to red.
Me!cmdRequery.ForeColor = 255

End If

PROC_EXIT:
Exit Function

PROC_ERR:
MsgBox Err.Description
Resume PROC_EXIT

End Function

Private Sub BtnClear_frmMusicSearch_Click()
' Comments : © 07/07/2001 F.W.Fisher, Jr
' Parameters:
' Modified : 05/24/2004 Rename button
'
' --------------------------------------------------

On Error GoTo PROC_ERR

Dim varDummy As Variant
Dim intCurrCat As Integer

'-- Clear all the criteria
'-- First, the Video Category multi-select list box.
For intCurrCat = 0 To Me!lboCategoryToInclude.ListCount - 1
Me!lboCategoryToInclude.Selected(intCurrCat) = False
Next

'-- Next, the Media Type multi-select list box.
For intCurrCat = 0 To Me!lboMediaTypeToInclude.ListCount - 1
Me!lboMediaTypeToInclude.Selected(intCurrCat) = False
Next

Me!chkRated01 = False
Me!chkRated02 = False
Me!chkRated03 = False
Me!chkRated04 = False
Me!chkRated05 = False
Me!chkRated06 = False
Me!chkRated07 = False
Me!chkRated08 = False
Me!chkRated09 = False
Me!chkRated10 = False

'-- Recreate the RecordSource for the subform
varDummy = RequerySubform()

PROC_EXIT:
Exit Sub

PROC_ERR:
MsgBox Err.Description
Resume PROC_EXIT

End Sub

Private Sub BtnExit_frmMusicSearch_Click()
' Comments : © 07/07/2001 F.W.Fisher, Jr
' Parameters:
' Modified : 05/24/2004 Rename button
'
' --------------------------------------------------

On Error GoTo Err_BtnExit_frmMusicSearch_Click

DoCmd.Close

Exit_BtnExit_frmMusicSearch_Click:
Exit Sub

Err_BtnExit_frmMusicSearch_Click:
MsgBox Err.Description
Resume Exit_BtnExit_frmMusicSearch_Click

End Sub

Private Sub BtnView_frmMusicSearch_Click()
' Comments : © 10/10/2001 F.W.Fisher, Jr
' Parameters:
' Modified : 05/24/2004 Rename button
'
' --------------------------------------------------

On Error GoTo Err_BtnView_frmMusicSearch_Click

Dim intRecordID As Integer
Dim rst As Recordset
Dim db As Database
Dim strSQL As String

Me![frmMusicSearchQuery].SetFocus
Me![frmMusicSearchQuery].Form![ID].SetFocus
DoCmd.GoToControl "ID"

intRecordID = Form![frmMusicSearchQuery].Form![ID]
strSQL = ("[CatalogID] = " & intRecordID)
DoCmd.OpenForm "frmViewMusicTitles", , , strSQL

Exit_BtnView_frmMusicSearch_Click:
Exit Sub

Err_BtnView_frmMusicSearch_Click:
MsgBox Err.Description
Resume Exit_BtnView_frmMusicSearch_Click

End Sub

Private Sub Form_Load()
' Comments : © 07/17/2002 F.W.Fisher, Jr
' Parameters:
' Returns :
' Modified :
'
' --------------------------------------------------

On Error GoTo PROC_ERR

Dim intNumberOfRecords As Integer
Me.intNumberOfRecords = 0

PROC_EXIT:
Exit Sub

PROC_ERR:
MsgBox Err.Description
Resume PROC_EXIT

End Sub

Private Function IncludeCategories() As String
' Comments : © 07/07/2001 F.W.Fisher, Jr
' Parameters:
' Returns : String
' Modified :
'
' --------------------------------------------------
'-- Create the Categories Where portion of the SQL statement

On Error GoTo PROC_ERR

Dim varCategory As Variant
Dim strTemp As String
' Dim intTemp As Integer

'-- for each of the items in the ItemsSelected collection
For Each varCategory In Me!lboCategoryToInclude.ItemsSelected()

strTemp = strTemp & "[CategoryID] = " & _
Me!lboCategoryToInclude.ItemData(varCategory) & " Or "

Next

If Len(strTemp) > 0 Then
IncludeCategories = "(" & Left$(strTemp, Len(strTemp) - 4) & ")"
Else
IncludeCategories = ""
End If

PROC_EXIT:
Exit Function

PROC_ERR:
MsgBox Err.Description
Resume PROC_EXIT

End Function

Private Function IncludeMediaTypes() As String
' Comments : © 07/07/2001 F.W.Fisher, Jr
' Parameters:
' Returns : String
' Modified :
'
' --------------------------------------------------
'-- Create the Media Type Where portion of the SQL statement

On Error GoTo PROC_ERR

Dim varMediaType As Variant
Dim strTemp As String
' Dim intTemp As Integer

'-- for each of the items in the ItemsSelected collection
For Each varMediaType In Me!lboMediaTypeToInclude.ItemsSelected()

strTemp = strTemp & "[MusicMediaID] = " & _
Me!lboMediaTypeToInclude.ItemData(varMediaType) & " Or "

Next

If Len(strTemp) > 0 Then
IncludeMediaTypes = "(" & Left$(strTemp, Len(strTemp) - 4) & ")"
Else
IncludeMediaTypes = ""
End If

PROC_EXIT:
Exit Function

PROC_ERR:
MsgBox Err.Description
Resume PROC_EXIT

End Function

Private Function IncludeRatings() As String
' Comments : © 07/07/2001 F.W.Fisher, Jr
' Parameters:
' Returns : String
' Modified :
'
' --------------------------------------------------
'-- Create the Categories Where portion of the SQL statement

On Error GoTo PROC_ERR

Dim strRating As String
Dim strTemp As String
Dim intTemp As Integer

If Me!chkRated00 Then
strRating = "0"
strTemp = "[Rating] = " & strRating
End If

If Me!chkRated01 Then
strRating = "1"
If Len(strTemp) <> 0 Then
strTemp = strTemp & " Or "
End If
strTemp = strTemp & "[Rating] = " & strRating
End If

If Me!chkRated02 Then
strRating = "2"
If Len(strTemp) <> 0 Then
strTemp = strTemp & " Or "
End If
strTemp = strTemp & "[Rating] = " & strRating
End If

If Me!chkRated03 Then
strRating = "3"
If Len(strTemp) <> 0 Then
strTemp = strTemp & " Or "
End If
strTemp = strTemp & "[Rating] = " & strRating
End If

If Me!chkRated04 Then
strRating = "4"
If Len(strTemp) <> 0 Then
strTemp = strTemp & " Or "
End If
strTemp = strTemp & "[Rating] = " & strRating
End If

If Me!chkRated05 Then
strRating = "5"
If Len(strTemp) <> 0 Then
strTemp = strTemp & " Or "
End If
strTemp = strTemp & "[Rating] = " & strRating
End If

If Me!chkRated06 Then
strRating = "6"
If Len(strTemp) <> 0 Then
strTemp = strTemp & " Or "
End If
strTemp = strTemp & "[Rating] = " & strRating
End If

If Me!chkRated07 Then
strRating = "7"
If Len(strTemp) <> 0 Then
strTemp = strTemp & " Or "
End If
strTemp = strTemp & "[Rating] = " & strRating
End If

If Me!chkRated08 Then
strRating = "8"
If Len(strTemp) <> 0 Then
strTemp = strTemp & " Or "
End If
strTemp = strTemp & "[Rating] = " & strRating
End If

If Me!chkRated09 Then
strRating = "9"
If Len(strTemp) <> 0 Then
strTemp = strTemp & " Or "
End If
strTemp = strTemp & "[Rating] = " & strRating
End If

If Me!chkRated10 Then
strRating = "10"
If Len(strTemp) <> 0 Then
strTemp = strTemp & " Or "
End If
strTemp = strTemp & "[Rating] = " & strRating
End If

If Len(strTemp) <> 0 Then
IncludeRatings = "(" & strTemp & ")"
End If

PROC_EXIT:
Exit Function

PROC_ERR:
MsgBox Err.Description
Resume PROC_EXIT

End Function

Private Sub optAutoRequery_AfterUpdate()
' Comments : © 07/07/2001 F.W.Fisher, Jr
' Parameters:
' Modified :
'
' --------------------------------------------------

On Error GoTo PROC_ERR

Dim varDummy As Variant

If Me!optAutoRequery Then
varDummy = RequerySubform()
End If

PROC_EXIT:
Exit Sub

PROC_ERR:
MsgBox Err.Description
Resume PROC_EXIT

End Sub

**************************

Any help would be greatly appreciated

 

[uwphotonut]

Found the problem...

I finally tracked down the problem. It was in the Requery function. The code that was causing all of the grief was the following which was to setup the ability to count the matching records:

Me.RecordSource = strFullSQL

The Fix:

Dim rst As Recordset
Dim db As Database
Set db = CurrentDb
Set rst = db.OpenRecordset(strFullSQL)

I do not know why it worked in 2003 and not 2007 but it works now!

 

[The_Doc_Man]

Probably a difference between the AC2k3 and AC2k7 libraries. Something analogous happened when MS introduced ADO objects alongside of DAO objects and didn't bother to tell anyone which was the default.