Форма висит при запуске запроса списка

Question

Моя форма висит в течение нескольких секунд каждый раз, когда пользователь переходит к новой записи. Набор записей для списка в форме - это запрос. Форма висит до тех пор, пока этот запрос не завершится, и список будет заполнен.

Мои пользователи должны иметь возможность быстро прокручивать записи. В настоящее время пользователь должен дождаться завершения запроса списка, прежде чем перейти к следующей записи. Как я могу приостановить форму?

Можно ли использовать 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 

Answer 1

Пользовательский интерфейс висит, потому что работа выполняется потоком пользовательского интерфейса. Если вы хотите (или нуждаетесь) более отзывчивое приложение, вам нужно разгрузить работу в фоновый поток. Насколько мне известно, для VBA это не что-то для сердца, но вы можете взглянуть, VBA + Threads in MS Access.

Поскольку доступ представляет собой базу данных, он страдает всеми недостатками любой базы данных, главным образом находя данные, хранящиеся на медленных, обычно вращающихся носителях. Я предлагаю вам взглянуть на эту статью: Create and use an index to improve performance, чтобы помочь вам создать эффективные индексы для ваших запросов, если вы уже не индексировали их. Вам также необходимо рассмотреть последствия для работы WHERE, JOIN и ORDER BY предложения в ваших запросах. Убедитесь, что ваши индексы оптимизированы для ваших запросов, и ваши данные хранятся логически, так как они будут запрошены. Кроме того, если база данных не находится на машине, с которой выполняются запросы, у вас есть задержка ввода-вывода сети в ожидании ожидаемой задержки ввода-вывода. Это может существенно повлиять на производительность чтения в базе данных.

Answer 2

Возможно, у вас может быть неправильное событие формы. Событие form_Current срабатывает между каждой записью, и я не могу себе представить, что вам действительно нужно. Вместо этого попробуйте переместить рутину «Матчи» в событие OnLoad.