Private Sub btn1_Click()
Const strFilename$ = "datas.accde" ' тот файл который ищете
On Error GoTo handle1
Dim Pathname$, r%, str$, Pathname2$, strPath$
strPath = CurrentProject.path
r = 0
str = "Выберите файл Access (" & strFilename & ")"
Pathname2 = openfilepathBase(str, strPath, r)
If r = 0 Then Exit Sub
If Dir(Pathname2) = "" Then Exit Sub
' здесь меняются пути к связанным таблицам (где-то была процедурка а вот
  Dim tD As DAO.TableDef
  For Each tD In currentdb.TableDefs
    If tD.Attributes And dbAttachedTable Then
      tD.Connect = Pathname2
      tD.RefreshLink
    End If
Next tD

Exit Sub
handle1:
' If RejDevel00pers Then Stop: Resume ' это режим отладки
End Sub
Function openfilepathBase(Titl$, Pathname$, Res%) As String
Dim str$
With Application.FileDialog(1)
   .Title = Titl
   .InitialFileName = Pathname
    .AllowMultiSelect = False
    .Filters.Clear
     .Filters.Add "MS Access", "*.accd?", 1
    Res = .Show
    If Res = 0 Then Exit Function
End With
If Trim(Application.FileDialog(1).SelectedItems.Item(1)) <> "" Then str = Trim(Application.FileDialog(1).SelectedItems.Item(1)) Else str = Pathname
openfilepathBase = str
End Function