mdb, A2000:
--------------

Function Prilinkovka(sBase)
'sBase = "c:\georgiy\tlfNew.mdb" ' путь к новому положению БД на диске

Dim dbs As Database
Dim tdf As TableDef
' Dim sBase As String
Dim lngX As Long

Set dbs = CurrentDb
SysCmd acSysCmdInitMeter, "Открываю таблицы базы " & sBase, dbs.TableDefs.Count
lngX = 0
For Each tdf In dbs.TableDefs
If Len(tdf.Connect) > 0 Then
tdf.Connect = ";DATABASE=" & sBase
tdf.RefreshLink
End If
SysCmd acSysCmdUpdateMeter, lngX
Next tdf
' MsgBox "Таблицы подлинкованы." & vbCr & sBase, vbOKOnly + vbInformation, "Минздрав доволен!"
SysCmd acSysCmdUpdateMeter, dbs.TableDefs.Count
SysCmd (acSysCmdClearStatus)
dbs.Close

End Function