BigMikeT76
Technical User
I'm using Access 2007. I created a split database and protected the front end as an accde file. I have a document search form that queries a listbox (looks like it was created by MAjP: Filter Sort List Box) of documents to choose from. It worked great before I split it, converted the front end to accde, and put it on our server. Now when it opens it blinks like it is reloading every time you try and select a record from the document list. There aren't very many records, maybe 30 max. Also, there are no errors generated. I'm not sure what I am missing, could someone please take a look at the code behind this form and see if it something obvious or is there something I need to do specifically for a filter/sort/list form before putting it onto a shared server (I work for an environmental state government agency where the server is secured)?
Code Behind the Form:
Code for FilterSortListBox:
Code Behind the Form:
Code:
Option Compare Database
Option Explicit
Dim fslDocs As FilterSortListBox
Private Sub cboseries_afterUpdate()
applyFilter
End Sub
Private Sub cboseries_Enter()
Dim strWhere As String
Dim strSql As String
If Not Trim(cbotype & " ") = "" Then
strWhere = "WHERE DocType = " & cbotype & " AND blnDocArchived <> -1 "
End If
strSql = "SELECT DISTINCT tblDocInfo.[DocSeries] FROM tblDocInfo "
strSql = strSql & strWhere & "ORDER BY tblDocInfo.[DocSeries]"
Debug.Print strSql
cboseries.RowSource = strSql
cboversion = Null
End Sub
Private Sub cbotype_AfterUpdate()
Me.cboseries = Null
Me.cboversion = Null
Call applyFilter
End Sub
Private Sub cbotype_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me!cbotype.SetFocus
Me!cbotype.Dropdown
End Sub
Private Sub cboseries_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me!cboseries.SetFocus
Me!cboseries.Dropdown
End Sub
Private Sub cboversion_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me!cboversion.SetFocus
Me!cboversion.Dropdown
End Sub
Private Sub cboversion_AfterUpdate()
applyFilter
End Sub
Private Sub cboversion_Enter()
Dim strWhere As String
Dim strSql As String
If Not Trim(cboseries & " ") = "" Then
strWhere = "WHERE DocSeries = " & cboseries & " AND blnDocArchived <> -1 "
Else
cbotype = Null
End If
strSql = "SELECT DISTINCT tblDocInfo.[DocVersion], getStrVersion([DocVersion]) AS strVersion FROM tblDocInfo "
strSql = strSql & strWhere & "ORDER BY tblDocInfo.[DocVersion]"
Debug.Print strSql
cboversion.RowSource = strSql
End Sub
Private Sub cmdCancel_Click()
DoCmd.Close acForm, Me.Name
End Sub
Private Sub cmdClear_Click()
fslDocs.FilterList ("")
End Sub
Private Sub cmdOK_Click()
Me.Visible = False
End Sub
Private Sub cmdseries_Click()
fslDocs.SortList ("DocSeries")
End Sub
Private Sub cmdtitle_Click()
fslDocs.SortList ("DocTitle")
End Sub
Private Sub cmdtrackingnumber_Click()
fslDocs.SortList ("TrackingNumber")
End Sub
Private Sub cmdtype_Click()
fslDocs.SortList ("SOPType,DocSeries,DocVersion")
End Sub
Private Sub cmdversion_Click()
fslDocs.SortList ("DocVersion")
End Sub
Private Sub Form_Load()
Call FindAsUTypeLoad(Me)
Set fslDocs = New FilterSortListBox
fslDocs.Initialize Me.lstDocuments
End Sub
Public Sub applyFilter()
Dim strType As String
Dim strVersion As String
Dim strSeries As String
Dim strFilter As String
If Not Trim(Me.cbotype & " ") = "" Then
strType = "DocType = " & Me.cbotype & " AND "
End If
If Not Trim(Me.cboversion & " ") = "" Then
strVersion = "DocVersion = " & Me.cboversion & " AND "
End If
If Not Trim(Me.cboseries & " ") = "" Then
strSeries = "DocSeries = " & Me.cboseries & " AND "
End If
strFilter = strType & strSeries & strVersion
strFilter = Left(strFilter, Len(strFilter) - 5)
fslDocs.FilterList (strFilter)
End Sub
Code for FilterSortListBox:
Code:
Option Compare Database
Option Explicit
Private WithEvents mListbox As Access.ListBox
Private WithEvents mForm As Access.Form
Private mFilterString As String
Private mSortString As String
Private mRsOriginalList As DAO.Recordset
Private Sub mListBox_AfterUpdate()
Call unFilterList
End Sub
Private Sub mForm_Current()
Call unFilterList
End Sub
Public Sub FilterList(FilterString As String)
'On Error GoTo errLable
Dim rsTemp As DAO.Recordset
Set rsTemp = mRsOriginalList.OpenRecordset
rsTemp.Filter = FilterString
Set rsTemp = rsTemp.OpenRecordset
If rsTemp.RecordCount > 0 Then
Set mListbox.Recordset = rsTemp
mListbox.Selected(0) = True
mListbox.Value = mListbox.Column(0)
Else
MsgBox "No Records Found"
Call unFilterList
End If
Exit Sub
errLable:
If Err.Number = 3061 Then
MsgBox "Will not Filter. Verify filter string is Correct."
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub
Private Sub unFilterList()
On Error GoTo errLable
Set mListbox.Recordset = mRsOriginalList
Exit Sub
errLable:
If Err.Number = 3061 Then
MsgBox "Will not Filter. Verify Field Name is Correct."
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub
Private Sub Class_Terminate()
Set mForm = Nothing
Set mListbox = Nothing
Set mRsOriginalList = Nothing
End Sub
Public Sub Initialize(theListBox As Access.ListBox)
' On Error GoTo errlabel
If Not theListBox.RowSourceType = "Table/Query" Then
MsgBox "This class will only work with a ListBox that uses a Table or Query as the Rowsource"
Exit Sub
End If
Set mListbox = theListBox
Set mForm = theListBox.Parent
mForm.OnCurrent = "[Event Procedure]"
mListbox.AfterUpdate = "[Event Procedure]"
Set mRsOriginalList = mListbox.Recordset.Clone
Exit Sub
errlabel:
MsgBox Err.Number & " " & Err.Description
End Sub
Public Sub SortList(SortString As String)
Dim rs As DAO.Recordset
Set rs = mListbox.Recordset
rs.Sort = SortString
Set mListbox.Recordset = rs.OpenRecordset
Set rs = mRsOriginalList
rs.Sort = SortString
Set mRsOriginalList = rs.OpenRecordset
End Sub