Question

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

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

我想做两件事之一：

以数据库路径为相对的方式建立数据库2中表的链接 - 数据库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

我们的企业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 4

我使用了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用户登录到前端数据库时，我直接使用ConnectTestDB函数来默认将admin用户连接到测试数据库。同样，当其他用户登录到前端时，也可以使用ConnectLiveDB函数。

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

Answer 5

根据文件所在的位置，您也许可以使用相对路径。 Access查找的默认位置在文档（C：\ Users \ UserName \ Documents）中。因此，如果输入..，它将使您从Documents（用户的文件夹）上移一个文件夹。例如，如果您的数据库文件将始终存储在

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

然后，您可以输入“ .. \ Access App \ Database”作为相关文件位置。否则，您必须使用VBA。就我而言，文件/文件夹可能并不总是位于同一位置，某些用户可能会将文件存储在其Google驱动器上，而另一些用户可能会使用“我的文档”或桌面。我能够使用类似于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事件过程调用此函数，因此每当首次加载/打开应用程序时都会调用该函数。这样，无论用户名是什么，它都将始终在相关的文件夹中查找。

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

5 个答案: