Public Sub MyStart()
Dim MyDb As Database
Dim tdf As TableDef
Dim Str As Variant
Dim Inna As String
Dim test As Variant
Dim Name As String
Dim Out As String
Dim SourceName As String
Dim Connect As String
Dim strFileName As String
Dim tdfArray( 256 ,  4 ) As String
Dim Ct As Long
Dim II As Long
Dim Flagsearch As Variant
Dim Len_inna As Variant
Set MyDb = CurrentDb
II =  0 
'цикл по табличкам формирует массив длинной Ct содержащий Name,SourceTableName,Connect
For Each tdf In MyDb.TableDefs
     If Len(tdf.SourceTableName) > 1 Then
         Str = tdf.Connect
         Str = Right(Str, Len(Str) - 10)
On Error GoTo ErrorHandler
         Len_inna = Len(Dir(Str))
       
         If Len_inna < 5 Then
               Connect = tdf.Connect
               SourceName = tdf.SourceTableName
               Name = tdf.Name
               tdfArray(II, 0) = Name
               tdfArray(II, 1) = SourceName
               tdfArray(II, 2) = Connect
               II = II + 1
        End If
     End If
Next tdf
Ct = II
           Flagsearch = 0
           If Ct > 0 Then test = MsgBox("Не найдены присоединенные таблицы    Yes - игноре NO - переприсоединить Cansel - общий путь", vbYesNoCancel)
           If (test = 6) Then GoTo alless
           If (test = 2) Then Flagsearch = 1
For II = 0 To Ct - 1
               Name = tdfArray(II, 0)
               SourceName = tdfArray(II, 1)
               Connect = tdfArray(II, 2)
               If Flagsearch < 2 Then
                   If Flagsearch = 1 Then Flagsearch = 2
                   Out = "Было:" & "имя-->" & Name & "табличка---->" & SourceName & "путь к mdb -->" & Right(Connect, Len(Connect) - 10)
                   MsgBox (Out)
                   strFileName = OpenFile(".", "")
               End If
                    If (Len(strFileName) > 5) Then
                           Connect = strFileName
                           MyDb.TableDefs.Delete (Name) ' при удалении
                           Call MyAddtable(Name, SourceName, Connect)
                    End If
Next II
alless:
Out = Out
Exit Sub
ErrorHandler:   ' Обработчик ошибок.
Select Case Err.Number
Case 68 ' "Ошибка "путь не верен".
             Len_inna = 0
             Resume Next
End Select
Public Sub MyAddtable(Name As String, SourceName As String, Connect As String)
 Dim MyDb As Database
 Dim tdw As TableDef
  Set MyDb = CurrentDb
  Set tdw = MyDb.CreateTableDef(Name)
  tdw.Connect = ";DATABASE=" & Connect
  'tdw.Connect = Connect
  tdw.SourceTableName = SourceName
  MyDb.TableDefs.Append tdw
  Set MyDb = Nothing
End Sub