我在第二个数据库中有一个带有链接表的 Access 数据库,该数据库与第一个数据库位于同一目录中。
我想将整个目录复制到一个新位置(用于测试)并使数据库一仍然链接到数据库二中的表,但链接仍然是原始目录,而不是新位置。
我想做两件事之一:要么
以文件夹路径是相对的方式创建到数据库 2 中表的链接 - 数据库 2 的路径不是硬编码的。
或者
在(或 autoexec 宏)中有一个例程
Form_Load
来检查 application.path 并以编程方式相应地调整链接。
我在第二个数据库中有一个带有链接表的 Access 数据库,该数据库与第一个数据库位于同一目录中。
我想将整个目录复制到一个新位置(用于测试)并使数据库一仍然链接到数据库二中的表,但链接仍然是原始目录,而不是新位置。
我想做两件事之一:要么
以文件夹路径是相对的方式创建到数据库 2 中表的链接 - 数据库 2 的路径不是硬编码的。
或者
在(或 autoexec 宏)中有一个例程Form_Load
来检查 application.path 并以编程方式相应地调整链接。
谢谢,
我成功地使用了它,但是没有将它与记录集一起使用。
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
拥有一个允许您浏览所需后端以及应链接的表的表的启动表单会很有用。您可以遍历表集合,但我认为列表稍微安全一些。之后,只需要一点代码,这里是一个片段:
''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
我使用了 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 函数之前告诉我是否有两个环境的混合连接。如果此错误反复出现,则可能是其他问题的迹象。
我们的公司 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
您可以根据文件所在的位置使用相对路径。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 事件过程调用此函数,因此每当应用程序首次加载/打开时都会调用它。这样,无论用户名是什么,它都会始终查看相关的文件夹。