Зависания при поиске по распределенной базе

Option Compare Database
Option Explicit
Dim rst As QueryDef
Dim SearchOfStr, SearchOfControl, rstRepl, QueryType As String
Dim bar As ProgressBar
 
Private Sub Cancel_Click()
    DoCmd.Close
End Sub
 
Private Sub Search_Click()
    'Поиск заказной спецификации
    If Me.List.Value = "№ Заказной спецификации" Then
        Call SearchSub("tblCustomSpec.CustomSpec", "searchZSNumber", "frmCheckInZSNumber")
    ElseIf Me.List.Value = "Номенклатура SAP" Then
        Call SearchSub("tblMotion.NomenclatureSAP", "searchNomen", "frmCheckInNomen")
    ElseIf Me.List.Value = "Менеджер" Then
        Call SearchSub("tblCustomSpec.ManagerBuilding", "searchManager", "frmCheckInZSNumber")
    ElseIf Me.List.Value = "№ Договора СМР" Then
        Call SearchSub("tblMotion.TreatySMR", "searchTreaty", "frmCheckInTreaty")
    ElseIf Me.List.Value = "Количество" Then
        Call SearchSub("tblMotion.Quantity", "searchNomen", "frmCheckInNomen")
    End If
End Sub
 
'Поиск
'SearchOfControl - по какому полю будем искать
'QueryType - какой запрос использовать (зависит от стола)
'FormType - какую форму открыть
Private Sub SearchSub(SearchOfControl, QueryType, FormType)
    'Строка поиска
    SearchOfStr = Me.SearchString.Value
If IsTable.IsTable("tmpCheck") = True Then
    CurrentDb.Execute "DROP TABLE tmpCheck"
    Set rst = CurrentDb.QueryDefs(QueryType)
    rstRepl = rst.SQL
    rst.SQL = Replace(rstRepl, "SearchOfControl", SearchOfControl)
    'Передаем параметр для запроса
    rst.Parameters(0) = SearchOfStr
    rst.Execute
    rst.SQL = rstRepl 'Меняем SQL запрос на прежнее значение
    CurrentDb.Execute "ALTER TABLE tmpCheck ADD COLUMN Kod COUNTER"
    If DCount("*", "tmpCheck") > 0 Then
        DoCmd.Close
        DoCmd.OpenForm FormType, , , , acFormReadOnly, acWindowNormal
    Else
        DoCmd.Close
        MsgBox "Ничего не найдено", vbOKOnly
        CurrentDb.Execute "DROP TABLE tmpCheck"
    End If
Else
    Set rst = CurrentDb.QueryDefs(QueryType)
    rstRepl = rst.SQL
    rst.SQL = Replace(rstRepl, "SearchOfControl", SearchOfControl)
    'Передаем параметр для запроса
    rst.Parameters(0) = SearchOfStr
    rst.Execute
    rst.SQL = rstRepl 'Меняем SQL запрос на прежнее значение
    CurrentDb.Execute "ALTER TABLE tmpCheck ADD COLUMN Kod COUNTER"
    If DCount("*", "tmpCheck") > 0 Then
        DoCmd.Close
        DoCmd.OpenForm FormType, , , , acFormReadOnly, acWindowNormal
    Else
        DoCmd.Close
        MsgBox "Ничего не найдено", vbOKOnly
        CurrentDb.Execute "DROP TABLE tmpCheck"
    End If
End If
    rst.Close
    Set rst = Nothing
    
End Sub

IsTable.IsTable("tmpCheck")

'Проверка сущетвования таблицы
Public Function IsTable(NameTable As String) As Boolean
   Dim i As Integer
   IsTable = False
   For i = 0 To CurrentDb.TableDefs.Count - 1
      If CurrentDb.TableDefs(i).Name = NameTable Then IsTable = True
   Next i
End Function

Public Function IsTablePresent(strTableName As String) As Boolean
' Проверка на наличие таблицы в текущей базе данных
' Если  таблица существует - вернет True (Истина = -1)
'--------------------------------------------------------------------
Dim i As Integer
On Error GoTo IsTablePresent_Err
 
' Пытаемся посчитать кол-во полей в заданной таблице
    i = CurrentDb.TableDefs(strTableName).Fields.Count
    
' Если поля есть - значит и таблица существует (что вполне логично)
    If i > 0 Then IsTablePresent = True
 
IsTablePresent_Bye:
    Exit Function
 
IsTablePresent_Err:
    Resume IsTablePresent_Bye
End Function

If CurrentDb.TableDefs(i).Name = NameTable Then IsTable = True: Exit Function