Предыстория: меняется база ORACLE (переезд с 7 на 10). Меняются адреса, TNS names, ODBS.
Есть порядка 500 Access баз . Перелинковывать таблицы в каждой базе скриптом не очень хочется, а уж тем более вручную.
Задачка:
1. Нужно программно пробежаться по заданной директории (включая вложенные) - решаемо.
2. Если база Access, то открыть
2-1. Пробежаться по коллекции таблиц, если прилинкованная и имя сервера равно искомому, то перелинковать.
2-2. Пробежаться по коллекции запросов, если запрос к серверу и имя сервера равно искомому, то перелинковать.
2-3. Проверить модули VBA (а так же формы и отчеты ) на зашитость в коде имен серверов, при необходимости поменять и откомпилить.
3. По идее базу надо сжать.

Option Compare Database
Option Explicit

Declare Function SQLDataSources Lib "odbc32.dll" (ByVal HENV As Long, _
                                                  ByVal Direction As Long, _
                                                  ByVal DSN As String, _
                                                  ByVal DSNMax As Integer, _
                                                  ByRef DSNLen As Integer, _
                                                  ByVal Description As String, _
                                                  ByVal DescriptionMax As Integer, _
                                                  ByRef DescriptionLen As Integer) As Integer

Declare Function SQLAllocEnv Lib "odbc32.dll" (ByRef HENV As Long) As Integer

Const SQL_SUCCESS As Long = 0
Const SQL_FETCH_NEXT As Long = 1

' ===========================================================================
' Назначение модуля:
'           Настройка связанных таблиц между базами данных
' Автор:                            Силыч
' Организация:                      **************
' Дата начала разработки:           12.12.2006
' Дата последней модификации:
' ===========================================================================


' ===========================================================================
' Назначение процедуры:
'           Настройка связанных таблиц на удаленные базы данных
' Автор:                            Силыч
' Создание:                         12.12.2006
' Последняя модификация:
' ===========================================================================
Public Function RefreshLinkTables(Optional SolveOrder& = 0) As Boolean
Dim rstPath     As ADODB.Recordset
Dim spcRS       As DAO.Recordset
Dim stf         As DAO.TableDef
Dim dtf         As DAO.TableDef
Dim sbd         As DAO.Database
Dim dbd         As DAO.Database
Dim cbd         As DAO.Database
Dim strSQL$, strConnect$, sTbNam$, spcID&, spcCurrentID&

On Error GoTo ErrRefreshLinkTables
    '-- В этой таблице содержится информация о настройках приложения.
    '-- Там, где bLink = True указываются пути к файлам баз данных
    Set cbd = CurrentDb
    If SolveOrder = 0 Then
        strSQL = "SELECT * FROM _tuneLinks order by iOrder"
    Else
        strSQL = "SELECT * FROM _tuneLinks WHERE sOrder=" & SolveOrder & " order by iOrder"
    End If
    Set rstPath = New ADODB.Recordset
    With rstPath
        .Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
        Do Until .EOF
            '-- только для существующих источников и приемников
            If (Len(Dir(.Fields("srcPath"))) <> 0 And _
                 .Fields("lnkType") <> 3) Or _
                ((.Fields("dstPath") <> "CurrentDB" And _
                UCase(Right(.Fields("dstPath"), 3)) <> "MDB" And _
                Len(Dir(.Fields("dstPath"))) <> 0)) Then
                
                '-- далее, в зависимости от типа настройки
                Select Case .Fields("lnkType")
'-- Link ODBC----------------------------------------------------------
                Case 3
                    If .Fields("dstPath") = "CurrentDB" Then
                        Set dbd = cbd
                    Else
                        Set dbd = DBEngine.Workspaces(0).OpenDatabase(.Fields("dstPath"))
                    End If
                    '-- удалить связь
                    On Error Resume Next
                    dbd.TableDefs.Delete .Fields("lnkNam")
                    dbd.TableDefs.Refresh
                    On Error GoTo ErrRefreshLinkTables
                    '-- создать по новой, если bLink<>0
                    If .Fields("bLink") <> 0 And .Fields("aLink") <> 0 Then
                        Set dtf = dbd.CreateTableDef(.Fields("lnkNam"))
                        '--"ODBC;DSN=SERVER.XXXYYY;UID=UserID;PWD=PASSWORD;DATABASE=DBNAME;AutoTranslate=No"
                        dtf.Connect = .Fields("srcPath")
                        dtf.SourceTableName = .Fields("objNam")
                        'добавляем таблицу в семейство TableDefs
                        dbd.TableDefs.Append dtf
                        dbd.TableDefs.Refresh
                    End If
'-- Link TXT ----------------------------------------------------------
                Case 2
                    sTbNam = GetShortFileName(.Fields("srcPath"))
                    Set dbd = DBEngine.Workspaces(0).OpenDatabase(.Fields("dstPath"))
                
                    '-- разберемся со спецификациями
                    spcID = 0
                    Set spcRS = cbd.OpenRecordset("SELECT * FROM MSysIMEXSpecs " & _
                               "WHERE SpecName='" & Nz(.Fields("spcNam"), "") & "'")
                    If Not spcRS.EOF Then spcCurrentID = spcRS.Fields("SpecID")
                    spcRS.Close
                    Set spcRS = dbd.OpenRecordset("SELECT * FROM MSysIMEXSpecs " & _
                               "WHERE SpecName='" & Nz(.Fields("spcNam"), "") & "'")
                    If Not spcRS.EOF Then spcID = spcRS.Fields("SpecID")
                    If spcID <> 0 Then
                        '-- удалим колонки
                        dbd.Execute "DELETE * FROM MSysIMEXColumns WHERE SpecID=" & spcID, dbFailOnError
                        '-- удалим пецификации
                        dbd.Execute "DELETE * FROM MSysIMEXSpecs WHERE SpecID=" & spcID, dbFailOnError
                        spcID = 0
                    End If
                    '-- залить по новой
                    cbd.Execute "INSERT INTO MSysIMEXSpecs (DateDelim,DateFourDigitYear," & _
                                "DateLeadingZeros,DateOrder,DecimalPoint,FieldSeparator," & _
                                "FileType,SpecName,SpecType,StartRow,TimeDelim) " & _
                                "IN '" & .Fields("dstPath") & "' " & _
                                "SELECT DateDelim,DateFourDigitYear," & _
                                "DateLeadingZeros,DateOrder,DecimalPoint,FieldSeparator," & _
                                "FileType,SpecName,SpecType,StartRow,TimeDelim " & _
                                "FROM MSysIMEXSpecs " & _
                                "WHERE SpecName='" & Nz(.Fields("spcNam"), "") & "'", dbFailOnError
                    '-- получить новый spcID,если все удачно
                    Set spcRS = dbd.OpenRecordset("SELECT * FROM MSysIMEXSpecs WHERE SpecName='" & Nz(.Fields("spcNam"), "") & "'")
                    If Not spcRS.EOF Then spcID = spcRS.Fields("SpecID")
                    '-- нет такой спецификации или не удалось создать
                    If spcID = 0 Then
                        MsgBox "Ошибка при обновлении связей таблиц:" & vbCrLf & "Не удалось создать спецификацию" & vbCrLf & _
                               "[" & .Fields("spcNam") & "]" & vbCrLf & _
                               "Обратитесь к разработчикам.", vbExclamation + vbOKOnly, "Обновление связей таблиц"
                        GoTo Exit1
                    Else
                        cbd.Execute "INSERT INTO MSysIMEXColumns (SpecID,Attributes," & _
                                    "DataType,FieldName,IndexType,SkipColumn,Start,Width) " & _
                                    "IN '" & .Fields("dstPath") & "' " & _
                                    "SELECT " & spcID & " as SpecID,Attributes," & _
                                    "DataType,FieldName,IndexType,SkipColumn,Start,Width " & _
                                    "FROM MSysIMEXColumns " & _
                                    "WHERE SpecID=" & spcCurrentID, dbFailOnError
                    End If
                    '-- по любасу удалить связь нах
                    '-- имеем полное моральное право написать в данном случае
                    On Error Resume Next
                    dbd.TableDefs.Delete .Fields("lnkNam")
                    dbd.TableDefs.Refresh
                    On Error GoTo ErrRefreshLinkTables
                    '-- создать по новой, если bLink<>0
                    If .Fields("bLink") <> 0 And .Fields("aLink") <> 0 Then
                        Set dtf = dbd.CreateTableDef(.Fields("lnkNam"))
                        dtf.Connect = "Text;DSN=" & .Fields("spcNam") & ";FMT=" & .Fields("spcFMT") & _
                                      ";HDR=NO;IMEX=2;CharacterSet=" & .Fields("spc4set") & ";" & _
                                      "DATABASE=" & Left(.Fields("srcPath"), Len(.Fields("srcPath")) - Len(sTbNam) - 1)
                        dtf.SourceTableName = sTbNam
                        'добавляем таблицу в семейство TableDefs
                        dbd.TableDefs.Append dtf
                        dbd.TableDefs.Refresh
                    End If
'-- Link Excel ----------------------------------------------------------
                Case 1
                    '-- создать по новой, если bLink<>0 And .Fields("aLink")
                    If .Fields("bLink") <> 0 And .Fields("aLink") <> 0 Then
                        sTbNam = GetShortFileName(.Fields("srcPath"))
                        If .Fields("dstPath") = "CurrentDB" Then
                            Set dbd = cbd
                        Else
                            Set dbd = DBEngine.Workspaces(0).OpenDatabase(.Fields("dstPath"))
                        End If
                        '-- удалить связь
                        On Error Resume Next
                        dbd.TableDefs.Delete .Fields("lnkNam")
                        dbd.TableDefs.Refresh
                        On Error GoTo ErrRefreshLinkTables
                        '-- создать по новой, если bLink<>0
                        If .Fields("bLink") <> 0 And .Fields("aLink") <> 0 Then
                            Set dtf = dbd.CreateTableDef(.Fields("lnkNam"))
                            dtf.Connect = "Excel 5.0;DATABASE=" & .Fields("srcPath")
                            dtf.SourceTableName = Trim(.Fields("objNam")) & "$"
                            'добавляем таблицу в семейство TableDefs
                            dbd.TableDefs.Append dtf
                            dbd.TableDefs.Refresh
                            'Set sbd = DBEngine.Workspaces(0).OpenDatabase(.Fields("srcPath"))
                        End If
                    End If
'-- Link Access ----------------------------------------------------------
                Case 0
                    sTbNam = GetShortFileName(.Fields("srcPath"))
                    If .Fields("dstPath") = "CurrentDB" Then
                        Set dbd = cbd
                    Else
                        Set dbd = DBEngine.Workspaces(0).OpenDatabase(.Fields("dstPath"))
                    End If
                    '-- удалить связь
                    On Error Resume Next
                    dbd.TableDefs.Delete .Fields("lnkNam")
                    dbd.TableDefs.Refresh
                    On Error GoTo ErrRefreshLinkTables
                    '-- создать по новой, если bLink<>0
                    If .Fields("bLink") <> 0 And .Fields("aLink") <> 0 Then
                        Set dtf = dbd.CreateTableDef(.Fields("lnkNam"))
                        dtf.Connect = ";DATABASE=" & .Fields("srcPath")
                        dtf.SourceTableName = .Fields("objNam")
                        'добавляем таблицу в семейство TableDefs
                        dbd.TableDefs.Append dtf
                        dbd.TableDefs.Refresh
                    End If
                End Select
                Set sbd = Nothing: Set dbd = Nothing
            End If
            .MoveNext
        Loop
    End With
    RefreshLinkTables = True
Exit1:
    rstPath.Close: Set rstPath = Nothing
    '-- Освобождение объектов
    Set stf = Nothing: Set dtf = Nothing
    Set sbd = Nothing: Set dbd = Nothing: Set cbd = Nothing
    Exit Function
'-- Обработка ошибки подключения
ErrRefreshLinkTables:
    MsgBox "Ошибка при обновлении связей таблиц:" & vbCrLf & Err.Description, _
            vbExclamation + vbOKOnly, "Обновление связей таблиц"
    RefreshLinkTables = False
    GoTo Exit1
End Function

'
Function ODBC_GetListDSN()
    Dim i As Integer
    Dim sDSNItem As String * 1024
    Dim sDRVItem As String * 1024
    Dim sDSN As String
    Dim sDRV As String
    Dim iDSNLen As Integer
    Dim iDRVLen As Integer
    Dim lHenv As Long

    On Error Resume Next
    'получаем DSN's
    If SQLAllocEnv(lHenv) <> -1 Then
        Do Until i <> SQL_SUCCESS
            sDSNItem = Space$(1024)
            sDRVItem = Space$(1024)
            i = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, _
                iDSNLen, sDRVItem, 1024, iDRVLen)
            sDSN = Left$(sDSNItem, iDSNLen)
            sDRV = Left$(sDRVItem, iDRVLen)
                 
            If sDSN <> Space(iDSNLen) Then
               Debug.Print sDSN, sDRV
            End If
        Loop
    End If
End Function


Function Translit_TO_ODBC(Source$) As String
Dim i%, R$
For i = 1 To Len(Source)
Select Case Mid(Source, i, 1)
'-------------------------------------------------------------------------------------
Case "А"
R = R + "A"
Case "Б"
R = R + "A"
Case "В"
R = R + "A"
Case "Г"
R = R + "A"
Case "Д"
R = R + "A"
Case "Е"
R = R + "A"
Case "Ж"
R = R + "?"
Case "З"
R = R + "C"
Case "И"
R = R + "E"
Case "Й"
R = R + "E"
Case "К"
R = R + "E"
Case "Л"
R = R + "E"
Case "М"
R = R + "I"
Case "Н"
R = R + "I"
Case "О"
R = R + "I"
Case "П"
R = R + "I"
Case "Р"
R = R + "?"
Case "С"
R = R + "N"
Case "Т"
R = R + "O"
Case "У"
R = R + "O"
Case "Ф"
R = R + "O"
Case "Х"
R = R + "O"
Case "Ц"
R = R + "O"
Case "Ч"
R = R + "?"
Case "Ш"
R = R + "O"
Case "Щ"
R = R + "U"
Case "Ъ"
R = R + "U"
Case "Ы"
R = R + "U"
Case "Ь"
R = R + "U"
Case "Э"
R = R + "Y"
Case "Ю"
R = R + "?"
Case "Я"
R = R + "?"
Case "а"
R = R + "a"
Case "б"
R = R + "a"
Case "в"
R = R + "a"
Case "г"
R = R + "a"
Case "д"
R = R + "a"
Case "е"
R = R + "a"
Case "ж"
R = R + "?"
Case "з"
R = R + "c"
Case "и"
R = R + "e"
Case "й"
R = R + "e"
Case "к"
R = R + "e"
Case "л"
R = R + "e"
Case "м"
R = R + "i"
Case "н"
R = R + "i"
Case "о"
R = R + "i"
Case "п"
R = R + "i"
Case "р"
R = R + "?"
Case "с"
R = R + "n"
Case "т"
R = R + "o"
Case "у"
R = R + "o"
Case "ф"
R = R + "o"
Case "х"
R = R + "o"
Case "ц"
R = R + "o"
Case "ч"
R = R + "?"
Case "ш"
R = R + "o"
Case "щ"
R = R + "u"
Case "ъ"
R = R + "u"
Case "ы"
R = R + "u"
Case "ь"
R = R + "u"
Case "э"
R = R + "y"
Case "ю"
R = R + "?"
Case "я"
R = R + "y"
Case "І"
R = R + "?"
Case "і"
R = R + "?"
Case "Ї"
R = R + "?"
Case "ї"
R = R + "?"
Case "є"
R = R + "?"
Case "Є"
R = R + "?"
Case "Ё"
R = R + "?"
Case "ё"
R = R + "?"
Case Else
R = R + Mid(Source$, i%, 1)
End Select
Next
Translit_TO_ODBC = R$
End Function

Function Translit_From_ODBC(Source$) As String
Dim i%, R$
For i = 1 To Len(Source)
Select Case Mid(Source, i, 1)

Case "L"
R = R + "А"
Case "+"
R = R + "Б"
Case "T"
R = R + "В"
Case "+"
R = R + "Г"
Case "-"
R = R + "Д"
Case "+"
R = R + "Е"
Case "a"
R = R + "Ж"
Case "A"
R = R + "З"
Case "L"
R = R + "И"
Case "г"
R = R + "Й"
Case "¦"
R = R + "К"
Case "T"
R = R + "Л"
Case "¦"
R = R + "М"
Case "="
R = R + "Н"
Case "+"
R = R + "О"
Case "¤"
R = R + "П"
Case "?"
R = R + "Р"
Case "?"
R = R + "С"
Case "E"
R = R + "Т"
Case "E"
R = R + "У"
Case "E"
R = R + "Ф"
Case "?"
R = R + "Х"
Case "I"
R = R + "Ц"
Case "I"
R = R + "Ч"
Case "I"
R = R + "Ш"
Case "-"
R = R + "Щ"
Case "-"
R = R + "Ъ"
Case "-"
R = R + "Ы"
Case "-"
R = R + "Ь"
Case "¦"
R = R + "Э"
Case "I"
R = R + "Ю"
Case "-"
R = R + "Я"
Case "O"
R = R + "а"
Case "?"
R = R + "б"
Case "O"
R = R + "в"
Case "O"
R = R + "г"
Case "o"
R = R + "д"
Case "O"
R = R + "е"
Case "µ"
R = R + "ж"
Case "?"
R = R + "з"
Case "?"
R = R + "и"
Case "U"
R = R + "й"
Case "U"
R = R + "к"
Case "U"
R = R + "л"
Case "y"
R = R + "м"
Case "Y"
R = R + "н"
Case "?"
R = R + "о"
Case "?"
R = R + "п"
Case "­"
R = R + "р"
Case "±"
R = R + "с"
Case "?"
R = R + "т"
Case "?"
R = R + "у"
Case "¶"
R = R + "ф"
Case "§"
R = R + "х"
Case "?"
R = R + "ц"
Case "?"
R = R + "ч"
Case "°"
R = R + "ш"
Case "?"
R = R + "щ"
Case "·"
R = R + "ъ"
Case "?"
R = R + "ы"
Case "?"
R = R + "ь"
Case "?"
R = R + "э"
Case "¦"
R = R + "ю"
Case " "
R = R + "я"
Case "-"
R = R + "І"
Case "¦"
R = R + "і"
Case "»"
R = R + "Ї"
Case "¬"
R = R + "ї"
Case "¬"
R = R + "Є"
Case "¦"
R = R + "є"
Case "?"
R = R + "ё"
Case "©"
R = R + "ё"
Case Else
R = R + Mid(Source$, i%, 1)
End Select
Next
Translit_From_ODBC = R
End Function

структура таблицы _tuneLinks (см. аттач)
пример данных