Изменение местоположения связанной таблицы программно

Question

У меня есть база данных Access со связанной таблицей во второй базе данных, расположенной в том же каталоге, что и первая.

Я хотел бы скопировать весь каталог в новое место (для тестирования) и иметь одну базу данных, которая по-прежнему связана с таблицей в базе данных два, но связь по-прежнему с исходным каталогом, а не с новым местоположением.

Я хотел бы сделать одну из двух вещей: либо

1. Сделать ссылку на таблицу в базе данных два таким образом, чтобы путь к папке был относительным -что путь к базе данных два не жестко закодирован.

   или

2. Есть подпрограмма в Form_Load (или макрос autoexec), которая проверяет application.path и программно корректирует связь соответственно.

Answer 1

Может быть полезно иметь стартовую форму, которая позволяет вам искать нужный серверный стол и таблицу таблиц, которые должны быть связаны.Вы можете перебрать коллекцию таблиц, но я думаю, что список немного безопаснее.После этого небольшой код - это все, что нужно, вот фрагмент:

''Connection string with database password 
strConnect = "MS Access;PWD=pw;DATABASE=" & Me.txtNewDataDirectory

Set rs = CurrentDb.OpenRecordset("Select TableName From LinkTables " _
& "WHERE TableType = 'LINK'")

Do While Not rs.EOF
    ''Check if the table is already linked, if it is, update the connection
    ''otherwise, link the table. 

    If IsNull(DLookup("[Name]", "MSysObjects", "[Name]='" & rs!TableName & "'")) Then
        Set tdf = db.CreateTableDef(rs!TableName, dbAttachSavePWD, _
            rs!TableName, strConnect)
        db.TableDefs.Append tdf
    Else
        db.TableDefs(rs!TableName).Connect = strConnect
    End If
    db.TableDefs(rs!TableName).RefreshLink
    rs.MoveNext
Loop

Answer 2

Спасибо,

Я использовал его успешно, но не использовал его с набором записей.

Const LnkDataBase = "C:\NorthWind.mdb"
Sub relinktables()
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strTable As String
Set dbs = CurrentDb()
For Each tdf In dbs.TableDefs
    If Len(tdf.Connect) > 1 Then 'Only relink linked tables
        If tdf.Connect <> ";DATABASE=" & LnkDataBase Then 'only relink tables if the are not linked right
            If Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
                strTable = tdf.Name
                dbs.TableDefs(strTable).Connect = ";DATABASE=" & LnkDataBase
                dbs.TableDefs(strTable).RefreshLink
            End If
        End if
    End If
Next tdf
End Sub

Answer 3

Я использовал решение usncahill и изменил его для своих нужд. У меня недостаточно репутации, чтобы проголосовать за их решение, поэтому, если вам нравится мой дополнительный код, пожалуйста, проголосуйте за нас обоих.

Мне нужен быстрый способ переключения между двумя внутренними базами данных, одна из которых содержит оперативные данные, а другая - данные испытаний. Поэтому я изменил ранее упомянутый код следующим образом:

Private Sub ReplaceLink(oldLink As String, newLink As String)
    Dim tbl As TableDef, db As Database

    Set db = CurrentDb

    For Each tbl In db.TableDefs
        If InStr(tbl.Connect, oldLink) > 0 Then
            tbl.Connect = Replace(tbl.Connect, oldLink, newLink)
            tbl.RefreshLink
        End If
    Next
End Sub

Public Function ConnectTestDB()
    ReplaceLink "Data.accdb", "Test.accdb"
End Function

Public Function ConnectLiveDB()
    ReplaceLink "Test.accdb", "Data.accdb"
End Function

Public Function TestDBSwitch()
    Dim tbl As TableDef, db As Database
    Dim wasData As Boolean
    Dim wasTest As Boolean

    wasData = False
    wasTest = False

    Set db = CurrentDb

    For Each tbl In db.TableDefs
        If InStr(tbl.Connect, "JGFC Flooring Data") > 0 Then
            wasData = True
        ElseIf InStr(tbl.Connect, "JGFC Flooring Test") > 0 Then
            wasTest = True
        End If
    Next

    If wasData = True And wasTest = True Then
        MsgBox "Data Mismatch.  Both Test and Live Data are currently linked! Connecting all tables to Test database. To link to Live database, please run again.", , "Data Mismatch"
        ConnectTestDB
    ElseIf wasData = True Then
        ConnectTestDB
        MsgBox "You are now connected to the Test database.", , "Connection Changed"
    ElseIf wasTest = True Then
        ConnectLiveDB
        MsgBox "You are now connected to the Live database.", , "Connection Changed"
    End If
 End Function

(В предыдущем коде предполагается, что файлы Test и Live Data находятся в одном каталоге, а имя файла заканчивается в Test и Data, но их можно легко изменить на другие пути / имена файлов)

Я вызываю TestSwitchDB с помощью кнопки в моей интерфейсной БД, чтобы быстро переключаться между тестированием и производственной средой. Моя БД Access имеет пользовательские элементы управления для переключения между пользовательскими средами, поэтому, когда пользователь с правами администратора входит в интерфейсную БД, я напрямую использую функцию ConnectTestDB, чтобы пользователь по умолчанию подключался к тестовой БД. Я также использую функцию ConnectLiveDB, когда другие пользователи входят в интерфейс.

Существует также быстрое обнаружение ошибок в функции TestSwitchDB, чтобы сообщить мне, есть ли смесь подключений к обеим средам до вызова функции переключения. Если эта ошибка повторяется, это может быть признаком других проблем.

Answer 4

Наша корпоративная ИТ-служба изменила путь к нашим общим файлам с локальных на корпоративные, что потребовало перенаправления всех наших таблиц базы данных.Это было бы больно, чтобы удалить и воссоздать все ссылки, особенно с несколькими различными базами данных, связанных.Я нашел этот вопрос, но ни один из других ответов не помог мне.Вот что я использовал.Обратите внимание, что для многих таблиц это займет некоторое время, так как каждое обновление может занять несколько секунд.

Public Sub Fix_Table_Locations()
    Dim tbl As TableDef, db As Database, strConnect As String

    Set db = CurrentDb

    For Each tbl In db.TableDefs
        If InStr(tbl.Connect, "Portion of connect string to change") > 0 Then
            tbl.Connect = Replace(tbl.Connect, "Portion of connect string to change", "New portion of connect string")
            tbl.RefreshLink
        End If
    Next
End Sub