Function ПоменятьДанные(Путь As String)
On Error GoTo ПоменятьДанные_err
Dim i As Integer
Dim Ss As String

Dim CurDB As Database
Set CurDB = DBEngine.Workspaces(0).Databases(0)
For i = 0 To CurDB.TableDefs.Count - 1 'По всем таблицам
If Mid(CurDB.TableDefs(i).Connect, 1, 9) = ";DATABASE" Then
Ss = ";DATABASE=" & Путь

' 'Обновить связь
CurDB.TableDefs(i).Connect = Ss
CurDB.TableDefs(i).RefreshLink
End If
Next i
ПоменятьДанные_exit:
Exit Function
ПоменятьДанные_err:
MsgBox Err.Description
MsgBox "Не удается подключить таблицу: " & CurDB.TableDefs(i).Name & " или базу данных:" & Путь
Resume Next
End Function