F
FredFisher
I have a form that have several unbound list boxes to make selections from.
One or more items can be selected in each box. This form has a subform that
displays the results in datasheet format for the selections in the main form.
I have an auto requery function that is triggered in the After Update event
of the list boxes in the main form. This worked great in 2003 but it does
not in 2007.
In 2007 the selections in the list boxes do not remain highlighted and the
first selection shows all of the records selected but it you change a
selection only one of the records is shown in the datasheet even if there are
more than one record that matches.
Below is the code that I use for this form:
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
************************************************
Anyone have any ideas. I have tried everything that I can think of. Thanks
Fred
One or more items can be selected in each box. This form has a subform that
displays the results in datasheet format for the selections in the main form.
I have an auto requery function that is triggered in the After Update event
of the list boxes in the main form. This worked great in 2003 but it does
not in 2007.
In 2007 the selections in the list boxes do not remain highlighted and the
first selection shows all of the records selected but it you change a
selection only one of the records is shown in the datasheet even if there are
more than one record that matches.
Below is the code that I use for this form:
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
************************************************
Anyone have any ideas. I have tried everything that I can think of. Thanks
Fred