Refreshing Links

[kavsmate]

I have a simple query that I hope you can help with. I have searched, but couldn't find an answer.

Basically, I have a split database with a number of linked tables on it. Several staff members have their own identical FE that link to the same BE. The FE sand BE are in the same folder. This works fine for us. When an adjustment needs to be made to the FE, I adkust the master copy and then create a version of it for each staff member. However, although the basic filepath is identical, some staff outside the office have different drive letters meaning that I have to manually relink the tables with each amendment.

Is there a piece of code that will refresh the links automatically. As I said, everything is in the same location on the server, it is only drive letters that change.

Thanks.

 

[moishy]

This should do it:

Function RefreshLinks(MyDbName As String, pwd As String) As Boolean

    ' Refresh links to the supplied database. Return True if successful.
    ' Attempts to connect to mdb named in the jetdatapath setting
    ' Application fails if mdb not found
    ' This demo assumes that all the linked tabled appear in the same back end
    ' Code will need to be manipulated if using side ends.
    ' Also need to ensure that Miscrosoft DAO 3.6 Object library is referenced

    '/Display message on status bar
    DoCmd.Echo True, "Refreshing table links, please wait..."
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef

    '/Does the path exist
    If Dir(MyDbName) = "" Then
        MsgBox "Couldn't open the BE.", vbCritical, "Error"

    End If

    ' 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
            If tdf.Connect <> ";DATABASE=" & MyDbName & ";PWD=" & pwd Then
                tdf.Connect = ";DATABASE=" & MyDbName & ";PWD=" & pwd
                Err = 0
                On Error Resume Next
                tdf.RefreshLink         ' Relink the table.
                If Err <> 0 Then
                    RefreshLinks = False
                    MsgBox "Wrong Password!", vbMsgBoxRtlReading + vbCritical, "Error"
                    Cancel = True
                    Exit Function
                End If
            End If
        End If
    Next tdf
    DoCmd.Echo True, "Done"

    RefreshLinks = True        ' Relinking complete.

End Function