Public Function RefreshLinks(ByVal sDatabase As String) As Boolean
On Error GoTo ErrorOut
 
    'Refresh table links to a backend database
 
    Dim dbs As Database
    Dim tdf As TableDef
    Dim sCurrentTDF As String
 
    ' Loop through all tables in the database.
    Set dbs = CurrentDb
    For Each tdf In dbs.TableDefs
        ' If the table has a connect string, it's a linked table.
        If Len(tdf.Connect) > 0 Then
            tdf.Connect = "ODBC;Driver={SQL SERVER};" & "Server=DBSERVER\DB1;" & "Database=" & sDatabase & ";" & "Trusted_Connection=no;" & "Uid=sa;" & "Pwd=secret"
            Err = 0
            On Error Resume Next
            sCurrentTDF = tdf.Name
            tdf.RefreshLink ' Relink the table.
            If Err <> 0 Then
                RefreshLinks = False
                Exit Function
            End If
        End If
    Next tdf
 
    RefreshLinks = True
ExitOut:
    Exit Function
ErrorOut:
     msgBox ("There was an error refreshing the link(s) for '" & sCurrentTDF & "':  " & vbCrLf & vbCrLf & Err.Description)
     Resume ExitOut
End Function