|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
在这篇文章中我们将向您展示即使当数据库文件已被移动到不同的文件夹时,如何可以用少量的代码调用一个过程,自动重新链接您的后台数据库的表。该过程还将可以用于有多个后台数据库的情况。最重要的是,你不需要了解很多完成这项工作的有关代码。
自动刷新链接表是很有意义的,尤其是在你把数据库文件分享给其他人的时候,它可以节省您大量的麻烦、操作和时间。您不需要自己操作,你也无需远程访问另一台计算机。此外,您还不必输入您的后台数据库或链接的表的名称。
那么,它到底是如何工作的?
这段代码可以从前台TableDefs集合中获取重要的信息。包括您链接表的名称和后台数据库的名称。然后使用此信息,以及现有路径的前台数据库来获取所需设置的TableDef 连接属性的字符串。接着遍历TableDefs集合,并使用TableDef中重新链接方法来刷新链接。
下面是代码将执行的操作:
1.后台文件和前台文件必须在同一个文件夹中,重新链接所有链接的 Access 数据库表。
2.当数据库移动到另一个文件夹或另一台计算机时,重新链接表。
3.重新链接多个后台 Access 数据库中的表。
4.不要求您输入或存储数据库或表的名称。
5.与一些方法不同,这段代码是如果有错误也不会丢失您的链接表或 TableDef 。
这段代码做不到的几件事:
1.它不会重新链接Access数据库表,除非他们已被链接。
2.它不会刷新表已被重命名或移动到其他后台的链接。
3.它不会重新链接表中已重命名的后台数据库。
4.它不会重新链接 ODBC、 Excel、 Outlook、 dBASE、 Paradox或任何其他类型的链接表或对象。
有几个要求:
1)前台文件和后台的表必须是相同的文件夹中。
这个要求允许文件被移动到其他任何文件夹中或另一台计算机中,那么这段代码将自动重新链接表。
2) 如果有窗体加载了或者运行了宏,调用 RefreshTableLinks 过程的代码必须添加到第一个窗体的打开事件中。
更准确地说,运行该代码之前,必须加载绑定表的窗体。所以您可以在非绑定窗体中使用其他程序,比如在调用RefreshTableLinks过程之前启动窗体。
重新链接表的函数:
Procedure: RefreshTableLinks
' Purpose: Refresh table links to back-ends in the same folder as front end.
' Note: Linked Tables can be in more than one back-end.
' Return: Returns a zero-length string if all tables are relinked.
' Return: or returns a string listing tables not relinked and errors.
'----------------------------------------------------------------------------
' 程序: RefreshTableLinks
' 目的: 刷新后台表链接到前台的同一文件夹中。
' 注: 链接的表可以在多个后台。
' 返回: 如果所有表都重新都链接,则返回一个零长度的字符串。
' 返回: 如果有错误没有链接则返回一个表清单的字符串。
'----------------------------------------------------------------------------
Public Function RefreshTableLinks() As String
On Error GoTo ErrHandle
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strCon As String
Dim strBackEnd As String
Dim strMsg As String
Dim intErrorCount As Integer
Set db = CurrentDb
' 遍历TableDefs集合。
For Each tdf In db.TableDefs
' 验证表是链接的表。
If Left$(tdf.Connect, 10) = ";DATABASE=" Then
' 获取现有的连接字符串。
strCon = Nz(tdf.Connect, "")
' 获取使用字符串函数的后台数据库的名称。
strBackEnd = Right$(strCon, (Len(strCon) - (InStrRev(strCon, "\") - 1)))
' 如果后台数据库有
If Len(strBackEnd & "") > 0 Then
Set tdf = db.TableDefs(tdf.Name)
' 建立新的连接属性值
tdf.Connect = ";DATABASE=" & CurrentProject.Path & strBackEnd
' 刷新链接表。
tdf.RefreshLink
Else
intErrorCount = intErrorCount + 1
strMsg = strMsg & "Error getting back-end database name." & vbNewLine
strMsg = strMsg & "Table Name: " & tdf.Name & vbNewLine
strMsg = strMsg & "Connect = " & strCon & vbNewLine
End If
End If
Next tdf
ExitHere:
On Error Resume Next
If intErrorCount > 0 Then
strMsg = "There were errors refreshing the table links: " _
& vbNewLine & strMsg & "In Procedure RefreshTableLinks"
RefreshTableLinks = strMsg
End If
Set tdf = Nothing
Set db = Nothing
Exit Function
ErrHandle:
intErrorCount = intErrorCount + 1
strMsg = strMsg & "Error " & Err.Number & " " & Err.Description
strMsg = strMsg & vbNewLine & "Table Name: " & tdf.Name & vbNewLine
strMsg = strMsg & "Connect = " & strCon & vbNewLine
Resume ExitHere
End Function
上面的过程是如果发生了一个错误则返回一个消息字符串。这使您可以静静地在立即窗口中的记录成功的重新链接表信息,而不是每次打开数据库时突然弹出令人讨厌的 MsgBox提示框。但是,如果当一个或多个表未能重新链接或有错误时,你需要通知用户,则可以使用 MsgBox 。
下面的代码演示了一种方法来调用该过程并使用 MsgBox 显示错误。
Dim strMsg As String
' 得到的消息赋值给strMsg。
strMsg = RefreshTableLinks()
' strMsg 将是一个零长度的字符串,则显示“所有的表已被成功链接”。
If Len(strMsg & "") = 0 Then
Debug.Print "All Tables were successfully relinked."
Else
' 通知用户有错误。
MsgBox strMsg, vbCritical
End If
它是一个让每次运行数据库的程序打开的好主意。你可以把 RefreshTableLinks 函数放在一个标准模块中,添加代码,在你的做的程序中调用该过程,在没有出现一个不能链接的表之前,你都可以忽略它的存在。除非数据库损坏,不过这应该在几率非常小的情况下 ,除非是有人要将一个文件移动到一个不同的文件夹或重命名的后台数据库。
此代码将只连接到前台数据库中已链接的 Access 数据库表。
|
|