Para hacer la llamada incluye esta línea en tu formulario
en el evento Form_Load y llama a la función con el 
nombre de una tabla que exista en tu MDB:

    ' Busca y vincula la Aplicacion...
    Comprueba_Vinculos "Configuracion"



Incluir en un Módulo

Option Compare Database
Option Explicit

Function Path_Vinculada(Tabla)
    ' devuelve el path de la BD donde está (o estaba) la tabla,
    ' o "" si no es una tabla vinculada
    Dim Todo  As String
    Dim Parte As String
    Dim i     As Integer
    Dim l     As Integer
    
    Todo = CurrentDb.TableDefs(Tabla).Connect
    If Todo = "" Then
        Path_Vinculada = ""
    Else
        i = InStr(Todo, "DATABASE=")
        If i = 0 Then
            Path_Vinculada = ""
        Else
            i = i + 9
            For l = i To Len(Todo)
                DoEvents
                If Mid(Todo, l, 1) = ";" Then
                    Exit For
                End If
            Next
            Path_Vinculada = Mid(Todo, i, l - i + 1)
        End If
    End If
    
End Function

Function SoloNombre(Path)
    Dim i As Integer
    
    For i = Len(Path) To 1 Step -1
        DoEvents
        If Mid(Path, i, 1) = "\" Then Exit For
        DoEvents
    Next
    SoloNombre = Mid(Path, i + 1)
    
End Function

Function Comprueba_Vinculos(Tabla)
    Dim Rs     As DAO.Recordset
    Dim Retval As String
    
    On Error GoTo Errores
    
    Retval = Path_Vinculada(Tabla)
    ' Esta línea se ejecutaría SÓLO en caso de error, pero Access XP pasa de mi y la tengo q poner aqui tb....
    Comprueba_Vinculos = Buscar_BDvinculada(SoloNombre(Retval))
    Set Rs = CurrentDb.OpenRecordset(Tabla, dbOpenDynaset)
    
    If Err = 0 Then
        Set Rs = Nothing
        Comprueba_Vinculos = True
    End If
    
    Set Rs = Nothing

Errores:
    If Err = 3044 Or Err = 3024 Then Comprueba_Vinculos = Buscar_BDvinculada(SoloNombre(Retval))
    
End Function

Function Buscar_BDvinculada(Nombre_BD As String)
    Dim PathPrg   As String
    Dim NuevoPath As String
    Dim ErrMsg    As String
    Dim Carpeta   As String
    
    PathPrg = CurrentProject.Path & "\" & Nombre_BD
    If (Dir(PathPrg) <> "") Then
        NuevoPath = PathPrg
    Else
        Beep
        MsgBox "No se encontró la base de datos '" & Nombre_BD & "'." _
            & vbCrLf & "Habrá que buscarla manualmente.", vbInformation, _
            "Error de vinculación"
        Carpeta = BrowseFolder("Seleccione la carpeta donde puede estar '" & Nombre_BD & "'")
        If Carpeta <> "" Then
            NuevoPath = BuscarConOffice(Carpeta, Nombre_BD)
        End If
        If NuevoPath = "" Then
            ErrMsg = "No es posible continuar sin '" & Nombre_BD & "'."
            GoTo error_buscar_BDvinculada
        End If
    End If
    ' Intentar refrescar vínculos
    If Refresca_Vinculos(NuevoPath) = 0 Then
        Buscar_BDvinculada = True
        Exit Function
    Else
        ErrMsg = "Aviso Nº: " & Err.Number & "  " & Err.Description
    End If
    
error_buscar_BDvinculada:
    MsgBox ErrMsg, vbCritical
    Buscar_BDvinculada = False
    
End Function

Function Refresca_Vinculos(PathBD)
    Dim tdf As TableDef
    
    For Each tdf In CurrentDb.TableDefs
        If tdf.Connect <> "" Then
            If InStr(tdf.Connect, SoloNombre(PathBD)) > 0 Then
                tdf.Connect = ";DATABASE=" & PathBD
                Err = 0
                On Error Resume Next
                tdf.RefreshLink
                DoEvents
                If Err <> 0 Then
                    Refresca_Vinculos = Err
                    Exit Function
                End If
            End If
        End If
    Next
    Refresca_Vinculos = 0
    
End Function

Function BuscarConOffice(Carpeta As String, fichero As String)
    ' Devolveremos la primera BD encontrada
    On Error GoTo BuscarConOffice_Err
    
    Dim fs As FileSearch
    Dim i  As Integer
    
    ' Buscar el fichero especificado
    Set fs = Application.FileSearch
    With fs
        .LookIn = Carpeta
        .SearchSubFolders = True
        .FileName = fichero
        If .Execute > 0 Then
            BuscarConOffice = fs.FoundFiles.Item(1)
        Else
            MsgBox "No se encontró en '" & Carpeta & "'."
        End If
    End With
    
    GoTo BuscarConOffice_Exit
    
BuscarConOffice_Exit:
    Set fs = Nothing
    Exit Function
    
BuscarConOffice_Err:
    MsgBox Err.Number
    Resume BuscarConOffice_Exit
    
End Function