Ich habe eine Prozedur, die alle Tabellen in einer Datenbank neu verknüpft, je nachdem, ob es sich um eine verknüpfte Tabelle handelt oder nicht. Derzeit ist dies so eingerichtet, dass es automatisch ausgeführt wird, da es in einem AutoExec-Makro festgelegt ist, das die Funktion aufruft.

Der Code funktioniert abernur wenn ich die datenbank schließe und wieder öffne. Ich weiß, dass dies daran liegt, dass dies getan werden muss, damit die neuen Links wirksam werden. Andernfalls ist es besser, den VBA-Code die Datenbank schließen und erneut öffnen zu lassen.

Vielen Dank im Voraus für das Feedback

P.S. Hier ist der Code, falls Sie neugierig sind:

'*******************************************************************
'*  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

BEARBEITEN

Nach Gords Kommentaren habe ich das Makro hinzugefügtAutoExec Methode zum Aufrufen des Codes unten. Hat jemand ein Problem damit?

Action: RunCode
Function Name: RefreshTableLinks()