表单在运行列表框查询时挂起

时间:2014-01-16 14:41:52

标签: vba ms-access access-vba doevents

每次用户转到新记录时,我的表单都会挂起几秒钟。表单上的列表框的记录集是查询。表单将一直挂起,直到该查询完成并填充列表框。

我的用户需要能够快速滚动记录。目前,用户必须等待列表框查询完成才能移动到下一条记录。如何阻止表格挂起?

有没有办法让DoEvents用来解决这个问题?

以下是我的代码。我怀疑看到所有这些代码并不是必需的,但为了以防万一我分享它。

我正在使用Access。

谢谢!

Option Compare Database   'Use database order for string comparisons
Option Explicit
Dim QuoteLogForm As Form
Public KeystrokeCount As Integer

'Define the similarity threshold for the matches list
Const SIMIL_THRESHOLD As Single = 0.83
Private m_strDialogResult As String

'The basis of this code was derived from http://www.accessmvp.com/tomvanstiphout/simil.htm

Private Sub Form_Current()    
    Matches
End Sub

Private Sub Matches()
      'This sub calls the functions necessary to generate a query that lists
      'the KFC RFQ #'s whose similarity exceeds the threashold, as defined above.

      Dim sql As String
      Dim strOpenArgs As String
      Dim strInClause As String

      'OpenArgs contains the part # to find similars for.
      strOpenArgs = Replace(Replace(Nz(Me.Part_Number_Textbox.Value), "-", ""), " ", "")                'Nz changes Nulls to blanks

      'Call the GetSimilarPartNos function below.
      'This function returns a string of KFC RFQ #'s that exceed the threashold, wrapped in single quotes and separated by commas.
      strInClause = GetSimilarPartNos(strOpenArgs)

      'If any similar part numbers were found, run a query to select all the listed records
      If VBA.Len(strInClause) > 0 Then
            'Select records whose KFC RFQ #'s are found in the strInClause list, sort from most to least similar
           sql = "select * from [Matches List Query] where [KFC RFQ #] in (" & strInClause & ")"    ' order by SimilPct desc, DateShort desc"

           '[Forms]![Price Form Parent]![Price Form].[Form].Customer_Filter_Box
          Set Me.[Matches List Form].Form.Recordset = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
      Else
            'If no similar KFC RFQ #'s were found, select no records
          sql = "select * from [Matches List Query] where 1 = 0"
          Set Me.[Matches List Form].Form.Recordset = CurrentDb.OpenRecordset(sql, dbOpenSnapshot)
      End If

End Sub

 Private Function GetSimilarPartNos(ByVal strPartNo As String) As String
 'The GetSimilarPartNos function calls the fnSimil function and compiles a list (strInClause)
 'of KFC RFQ #'s whose part numbers exceed the threashold
      Dim rs          As DAO.Recordset
      Dim strInClause As String
      Dim sngSimil    As Single

      'Erase all previous values in the [Quote Log].Simil field
      CurrentDb.Execute "update [Quote Log] set Simil = 0", dbFailOnError

      Set rs = CurrentDb.OpenRecordset("Quote Log")      ', dbOpenTable)

      'Loop to calculate the similarity of all part numbers
      While Not rs.EOF                  'Loop until the end
          Dim curPartNo As String
          curPartNo = Replace(Replace(Nz(rs![Part #]), "-", ""), " ", "")
            If rs![KFC RFQ #] = Me.[KFC RFQ #] Then
                GoTo 120
            End If
          sngSimil = fnSimil(curPartNo, strPartNo)

            'If the part number similarity value of a single record is greater than the 
            'threashold (as defined above), add the record's KFC RFQ # to strInClause
            'strInClause forms a list of KFC RFQ #'s whose part numbers exceed the threashold
            'in similarity, wrapped in single quotes and separated by commas
          If sngSimil >= SIMIL_THRESHOLD Then
              strInClause = strInClause & "'" & rs![KFC RFQ #] & "',"
              'Show the Simil value on this form
              rs.Edit
              rs!Simil = sngSimil
              rs.Update
          End If
 120    rs.MoveNext
      Wend
      rs.Close
      Set rs = Nothing

      'Once the strInClause is completed, remove the last comma from the list
      If Len(strInClause) > 0 Then strInClause = VBA.Left$(strInClause, Len(strInClause) - 1)
      GetSimilarPartNos = strInClause
End Function

2 个答案:

答案 0 :(得分:0)

UI正在悬空,因为工作正在由UI线程完成。如果您想要(或需要)响应更快的应用程序,则需要将工作卸载到后台线程。据我所知,对于VBA而言,这不是佯装的事,但你可以看看,VBA + Threads in MS Access

由于访问是一个数据库,它会遇到任何数据库的所有缺点,主要是查找存储在慢速,通常是旋转的媒体上的数据。我建议你看一下这篇文章:Create and use an index to improve performance,以帮助你为你的查询创建有效的索引,如果你还没有索引它们。您还需要考虑查询中WHEREJOINORDER BY子句的性能影响。确保您的索引针对您的查询进行了优化,并且您的数据以逻辑方式存储,以便查询出来。除此之外,如果数据库不驻留在执行查询的计算机上,则在预期的磁盘I / O延迟之上会出现网络I / O延迟。这可能会显着影响数据库的读取性能。

答案 1 :(得分:0)

我认为你可能有错误的表格事件。 form_Current事件在每条记录之间触发,我无法想象这就是你真正需要的东西。尝试将“匹配”例程移动到OnLoad事件中。