'*** Solo coloca un 'Textbox' para capturar la ruta (carpeta de datos) ***

Private Sub Me!TxtCarpetaDatos _AfterUpdate()
    On Error Resume Next
    If (Right(Me!TxtCarpetaDatos , 1) <> "\") Then
        Me!Me!TxtCarpetaDatos  = Me!Me!TxtCarpetaDatos  & "\"
    End If
    RefrescaDir Me!TxtCarpetaDatos , True
End Sub

'Si lo deseas puedes asignar como valor inicial al Textbox la carpeta donde esta instalada tu aplicacion.

Private Sub Form_Open(Cancel As Integer)
	Me!TxtCarpetaDatos = CarpetaActual()
End Sub


'------------ RUTINA PARA REFRESCAR VINCULOS A TABLAS --------------------
 
Sub RefrescaDir(Dir As String, Aviso As Integer)
    Dim Db As Database
    Dim Tdf As TableDef
    Dim I As Integer

    On Error GoTo MANEJAERROR
    Set Db = CurrentDb
    For I = 0 To Db.TableDefs.Count - 1
        If (Db.TableDefs(I).Connect <> "") Then
            Db.TableDefs(I).Connect = ";DATABASE=" & _
                Dir & "MiBasedeDatos.MDB;PWD=mipassword"
            Db.TableDefs(I).RefreshLink
        End If
    Next I
    Db.Close
    If (Aviso) Then
        MsgBox "La conexión a la base de datos se realizó con éxito", vbOKOnly, "Aviso"
    End If
GoTo FIN
MANEJAERROR:
    MsgBox "No Error: " & Err & vbNewLine & _
    "Mensaje de Error: " & ERROR, vbOKOnly, "Error al abrir la base de datos"
FIN:
End Sub


'NOTA: reemplazar'mipassword' con el password que corresponda o dejar en blanco si la b.d. no tiene contraseña asignada.


'---- OBETENER LA CARPETA ACTUAL
Function CarpetaActual() As String
    Dim D As String
    Dim I As Integer

    I = 1
    Do While InStr(I, Application.CurrentDb.Name, "\")
        I = InStr(I, Application.CurrentDb.Name, "\") + 1
    Loop
    CarpetaActual = Left(Application.CurrentDb.Name, I - 1)
End Function