Want code to auto re-link tables on startup

[meumax]

I have an Access app I want to distribute to users. Problem is they could put it in any location and my app uses linked tables to two different back end mdbs.

The structure will always be the same with the client in the root folder and the back ends in a data folder one level higher.

I need a VBA code which I can execute at startup that will check if all the linked tables need to be re-linked, and if they do, to try re-linking them to where the back ends should be given that they should always be in a data folder one level up from the client.

Any help would be appreciated.

 

[Remou]

This code may help, I use it with a start-up form that has a 'browse for file' button and a table of tables. You will find other posts on this topic in these fora, if you do an advanced search.

Sub CheckLinkPath()
Dim tdf As DAO.TableDef
Dim db As DAO.Database
Dim strConnect As String
Dim blnConnectError

    Set db = CurrentDb
    'Assume all is well
    blnConnectError = False
    
    'Check if all is well
    For Each tdf In db.TableDefs
        strConnect = tdf.Connect
        If Dir(Mid(strConnect, InStr(strConnect, "DATABASE=") + 9)) = "" Then
            'All is not well
            blnConnectError = True
        End If
    Next

    If blnConnectError Then
        Me.Visible = True
    Else
        DoCmd.Close acForm, Me.Name
        DoCmd.OpenForm "frmMainMenu"
    End If
    
End Sub

Sub ReLinkTables()
Dim db As DAO.Database
Dim strConnect As String
Dim rs As DAO.Recordset
Dim strSQL

On Error GoTo TrapError

    Set db = CurrentDb
    strConnect = ";DATABASE=" & Me.txtNewDataDirectory
    
    Set rs = db.OpenRecordset("sysTables")
    Do While Not rs.EOF
        If IsNull(DLookup("[Name]", "MSysObjects", "[Name]='" & rs!TableName & "'")) Then
            DoCmd.TransferDatabase acLink, "Microsoft Access", _
                Me.txtNewDataDirectory, acTable, rs!TableName, rs!TableName
        Else
            db.TableDefs(rs!TableName).Connect = strConnect
            db.TableDefs(rs!TableName).RefreshLink
        End If
        rs.MoveNext
    Loop
    
    strSQL = "UPDATE sysInfo Set DataDirectory ='" & Me.txtNewDataDirectory & "'"
    db.Execute strSQL
    
    Set db = Nothing

End Sub