Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Form with List box flickering/reloading-Filter Sort List Box by MAjP? 1

Status
Not open for further replies.

BigMikeT76

Technical User
May 8, 2010
15
US
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:
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



 
I converted the front end to accde, and put it on our server.
I am not saying that is your problem, but that is a problem. You just defeated the whole purpose of splitting the database. The Front end should reside on the local machine. Never run a front end off of a server.
 
I'm sorry, I mispoke. The front end is on the central computer in our lab in accde format and the backend on the server. I did create a shortcut and place it on the server, would that be an issue? Probably. Thanks for your help, the code behind the filter list box is fantastic. I am certain it lies on my end with the shortcut or something similar since it works fine before I try to secure it and place the backend on the server.

MT
 
Let me think about this for a while. I do not think it has to do with the shortcut, it is probably something in my code that I did not think of.
 
In order to try to isolate the problem, does the flickering stop if you comment this out in the class module? (Note this is not a fix because it will basically make the code unuseable.)
Code:
' Private Sub mForm_Current()
'   Call unFilterList
' End Sub
 
Here is my thought. The issue is likely a timing problem. When you put it on the server the timing is off. So events are competing with each other and basically forming a loop which could cause the flicker. The normal solution for timing issues is putting in DoEvents in the correct location.

DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent.

DoEvents is most useful for simple things like allowing a user to cancel a process after it has started, for example a search for a file. For long-running processes, yielding to the processor is better accomplished by using a Timer or delegating the task to an ActiveX EXE component. In the latter case, the task can continue completely independent of your application, and the operating system takes care of multitasking and time slicing.

Any time you temporarily yield to the processor within an event procedure, make sure the procedure is not executed again from a different part of your code before the first call returns; this could cause unpredictable results. In addition, do not use DoEvents if other applications could possibly interact with your procedure in unforeseen ways during the time you have yielded control.
See

If the flicker stopped by commenting it out then try
Private Sub mForm_Current()
doEvents
Call unFilterList
End Sub

Sometimes it requires a timer loop that call doEvents for a set period of time.
 
That is exactly what the problem was, sorry I thought I had responded already. Brings back memories of FORTRAN and DO Loops!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top