ms-access - 重新链接数据库表 : Access, VBA

Question

我有一个程序可以根据它们是否是链接表来重新链接数据库中的所有表。目前，这被设置为自动运行，因为它是在调用该函数的 AutoExec 宏中设置的。

该代码有效，但 仅当我关闭数据库并重新打开它时 .我知道这是因为需要这样做才能使新链接生效，但无论如何都解决了这个问题？或者，如果失败了，让 VBA 代码关闭数据库并重新打开它会更好吗？

提前感谢您的反馈

附言这是代码，以防您好奇:

'*******************************************************************
'*  This module refreshes the links to any linked tables  *
'*******************************************************************


'Procedure to relink tables from the Common Access Database
Public Function RefreshTableLinks() As String

On Error GoTo ErrHandler
    Dim strEnvironment As String
    strEnvironment = GetEnvironment

    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

    'Loop through the TableDefs Collection.
    For Each tdf In db.TableDefs

            'Verify the table is a linked table.
            If Left$(tdf.Connect, 10) = ";DATABASE=" Then

                'Get the existing Connection String.
                strCon = Nz(tdf.Connect, "")

                'Get the name of the back-end database using String Functions.
                strBackEnd = Right$(strCon, (Len(strCon) - (InStrRev(strCon, "\") - 1)))

                'Debug.Print strBackEnd

                'Verify we have a value for the back-end
                If Len(strBackEnd & "") > 0 Then

                    'Set a reference to the TableDef Object.
                    Set tdf = db.TableDefs(tdf.Name)

                    If strBackEnd = "\Common Shares_Data.mdb" Or strBackEnd = "\Adverse Events.mdb" Then
                        'Build the new Connection Property Value - below needs to be changed to a constant
                        tdf.Connect = ";DATABASE=" & strEnvironment & strBackEnd
                    Else
                        tdf.Connect = ";DATABASE=" & CurrentProject.Path & strBackEnd

                    End If

                    'Refresh the table links
                    tdf.RefreshLink

                End If

            End If

    Next tdf

ErrHandler:

 If Err.Number <> 0 Then

    'Create a message box with the error number and description
    MsgBox ("Error Number: " & Err.Number & vbCrLf & _
            "Error Description: " & Err.Description & vbCrLf)

End If

End Function

编辑

继 Gords 评论之后，我添加了宏 AutoExec调用下面代码的方法。有人看到这个问题吗？

Action: RunCode
Function Name: RefreshTableLinks() 

Answer 1

这种情况下最常见的错误是忘记 .RefreshLink TableDef 但您已经在这样做了。我刚刚测试了以下 VBA 代码，该代码在两个 Access 后端文件之间切换名为 [Products_linked] 的链接表:Products_EN.accdb (英文)和 Products_FR.accdb (法语)。如果我运行 VBA 代码，然后立即打开链接表，我会看到更改已经发生；我不必关闭并重新打开数据库。

Function ToggleLinkTest()
Dim cdb As DAO.Database, tbd As DAO.TableDef
Set cdb = CurrentDb
Set tbd = cdb.TableDefs("Products_linked")
If tbd.Connect Like "*_EN*" Then
    tbd.Connect = Replace(tbd.Connect, "_EN", "_FR", 1, 1, vbBinaryCompare)
Else
    tbd.Connect = Replace(tbd.Connect, "_FR", "_EN", 1, 1, vbBinaryCompare)
End If
tbd.RefreshLink
Set tbd = Nothing
Set cdb = Nothing
End Function

我什至测试了从 AutoExec 宏调用该代码，它似乎也按预期工作。

您可以尝试的一件事是调用 db.TableDefs.Refresh就在您的日常工作结束时，看看这是否有帮助。

编辑

这里的问题是数据库在其“应用程序选项”中指定了一个“显示表单”，并且该表单显然会自动打开 之前 AutoExec 宏运行。将重新链接代码的函数调用移动到该“启动表单”的 Form_Load 事件处理程序似乎是一个可能的解决方法。