当文件夹更改时,保留相同文件夹中Access DB的链接表 [英] Preserving linked tables for Access DBs in same folder when the folder changes
问题描述
我有两个共享链接表的Access数据库。它们一起部署在一个目录中,并通过Word表单中的代码进行访问。
I've got two Access databases that share linked tables. They are deployed together in a directory and accessed via code in a Word form.
如何确保在复制两个数据库时保留链接(一起)到另一个文件夹?由于我不是打开数据库本身(它是通过ADO访问),我不知道如何编写代码来刷新链接。
How can I make sure that the links are preserved when the two databases are copied (together) to a different folder? Since I'm not "opening" the database, per se (it's being accessed via ADO), I don't know how to write code to refresh the links.
推荐答案
更新14APR2009
我发现我之前给出的答案是错误的,所以我用新代码更新了它。
Update 14APR2009 I found that the previous answer I gave here was erroneous, so I updated it with new code.
如何继续
- 将以下代码复制到VBA模块。
-
从代码或VBA IDE中的 Immediate 窗口,只需输入:
RefreshLinksToPath Application.CurrentProject.Path
现在将重新链接所有链接表以使用应用程序所在的目录。
只需要完成一次或重新链接或添加新表时。
我建议每次启动你的应用程序时从代码中执行此操作。
然后你可以毫无问题地移动你的数据库。
This will now relink all the linked tables to use the directory where your application is located.
It only needs to be done once or whenever you relink or add new tables.
I recommend doing this from code every time you start your application.
You can then move your databases around without problems.
代码
'------------------------------------------------------------'
' Reconnect all linked tables using the given path. '
' This only needs to be done once after the physical backend '
' has been moved to another location to correctly link to '
' the moved tables again. '
' If the OnlyForTablesMatching parameter is given, then '
' each table name is tested against the LIKE operator for a '
' possible match to this parameter. '
' Only matching tables would be changed. '
' For instance: '
' RefreshLinksToPath(CurrentProject.Path, "local*") '
' Would force all tables whose ane starts with 'local' to be '
' relinked to the current application directory. '
'------------------------------------------------------------'
Public Function RefreshLinksToPath(strNewPath As String, _
Optional OnlyForTablesMatching As String = "*") As Boolean
Dim collTbls As New Collection
Dim i As Integer
Dim strDBPath As String
Dim strTbl As String
Dim strMsg As String
Dim strDBName As String
Dim strcon As String
Dim dbCurr As DAO.Database
Dim dbLink As DAO.Database
Dim tdf As TableDef
Set dbCurr = CurrentDb
On Local Error GoTo fRefreshLinks_Err
'First get all linked tables in a collection'
dbCurr.TableDefs.Refresh
For Each tdf In dbCurr.TableDefs
With tdf
If ((.Attributes And TableDefAttributeEnum.dbAttachedTable) = TableDefAttributeEnum.dbAttachedTable) _
And (.Name Like OnlyForTablesMatching) Then
collTbls.Add Item:=.Name & .Connect, key:=.Name
End If
End With
Next
Set tdf = Nothing
' Now link all of them'
For i = collTbls.count To 1 Step -1
strcon = collTbls(i)
' Get the original name of the linked table '
strDBPath = Right(strcon, Len(strcon) - (InStr(1, strcon, "DATABASE=") + 8))
' Get table name from connection string '
strTbl = Left$(strcon, InStr(1, strcon, ";") - 1)
' Get the name of the linked database '
strDBName = Right(strDBPath, Len(strDBPath) - InStrRev(strDBPath, "\"))
' Reconstruct the full database path with the given path '
strDBPath = strNewPath & "\" & strDBName
' Reconnect '
Set tdf = dbCurr.TableDefs(strTbl)
With tdf
.Connect = ";Database=" & strDBPath
.RefreshLink
collTbls.Remove (.Name)
End With
Next
RefreshLinksToPath = True
fRefreshLinks_End:
Set collTbls = Nothing
Set tdf = Nothing
Set dbLink = Nothing
Set dbCurr = Nothing
Exit Function
fRefreshLinks_Err:
RefreshLinksToPath = False
Select Case Err
Case 3059:
Case Else:
strMsg = "Error Information..." & vbCrLf & vbCrLf
strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf
strMsg = strMsg & "Description: " & Err.Description & vbCrLf
strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
MsgBox strMsg
Resume fRefreshLinks_End
End Select
End Function
此代码改编自此来源: http://www.mvps.org /access/tables/tbl0009.htm 。
我删除了对其他函数的所有依赖以使其自包含,这就是为什么它比它应该更长的原因。
This code is adapted from this source: http://www.mvps.org/access/tables/tbl0009.htm.
I removed all dependency on other functions to make it self-contained, that's why it's a bit longer than it should.
这篇关于当文件夹更改时,保留相同文件夹中Access DB的链接表的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!