以编程方式更改链接表位置

Question

我在第二个数据库中有一个带有链接表的 Access 数据库，与第一个数据库位于同一目录中。

我想将整个目录复制到一个新位置（用于测试），并让数据库 1 仍然链接到数据库 2 中的表，但链接仍然是原始目录，而不是新位置。

我想做两件事之一：要么

1. 以文件夹路径是相对的方式创建到数据库 2 中表的链接 - 数据库 2 的路径不是硬编码的。

   或

2. 在Form_Load（或自动执行宏）中有一个例程检查 application.path 并以编程方式相应地调整链接。

Answer 1

谢谢，

我成功使用它，但没有将它与记录集一起使用。

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 2

拥有一个允许您浏览所需后端的启动表单以及应链接的表的表会很有用。您可以遍历表集合，但我认为列表稍微安全一些。之后，只需要一点代码，这里是一个sn-p：

''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 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 DB 有用户控制在用户环境之间切换，所以当 admin 用户登录到前端 DB 时，我直接使用 ConnectTestDB 功能默认 admin 用户连接到测试 DB。我同样在其他用户登录前端时使用 ConnectLiveDB 功能。

TestSwitchDB 函数中还有一个快速错误检测功能，可以在调用 switch 函数之前告诉我是否存在与两个环境的混合连接。如果此错误反复出现，则可能是其他问题的征兆。

Answer 4

我们的公司 IT 将共享文件的路径从本地更改为公司，这需要重定向我们所有的数据库表。删除并重新创建所有链接会很痛苦，尤其是在链接多个不同数据库的情况下。我发现了这个问题，但其他答案对我来说都不是很好。以下是我使用的。请注意，由于每次更新可能需要几秒钟，因此对于许多表，这将需要一些时间。

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

Answer 5

您可以使用相对路径，具体取决于文件所在的位置。 Access 查找的默认位置是文档 (C:\Users\UserName\Documents)。因此，如果您输入 .. 那么它将带您从 Documents 上移一个文件夹，即用户的文件夹。例如，如果您的数据库文件将始终存储在

C:\Users\UserName\Access App\Access 数据库

然后您可以输入“..\Access App\Database”作为相关文件位置。否则你必须使用 VBA。在我的情况下，文件/文件夹可能并不总是在同一个位置，一些用户可能将文件存储在他们的谷歌驱动器上，而另一些用户可能使用我的文档或桌面。我能够使用类似于 usncahill 发布的功能：

Sub relinkBackendDB()
    Dim sFilePath As String
    Dim connectionString As String
    Dim tbl As TableDef
    Dim db As Database

    sFilePath = (Application.CurrentProject.Path & "\system\Dojo Boss Database.accdb")
    connectionString = ("MS Access;PWD=MyPassword;DATABASE=" & sFilePath)
    Set db = CurrentDb

    For Each tbl In db.TableDefs
        If Len(tbl.Connect) > 0 Then
            'MsgBox tbl.Connect 'If you're getting errors, uncomment this to see connection string syntax
            tbl.Connect = connectionString
            tbl.RefreshLink
        End If
    Next
End Sub

当我的“主页”表单加载时，我通过 on_load 事件过程调用此函数，因此每当首次加载/打开应用程序时都会调用它。这样，无论用户名是什么，它都会始终在相关文件夹中查找。