Access - Cambiar ruta base de datos Access

Private Sub cmdLinkDB_Click()

On Error GoTo Err_cmdLinkDB_Click

    Dim sOrigen As String

    sOrigen = Me.Application.CurrentProject.Path & "\" & "hotelsusa_be.accdb"

On Error Resume Next

    DoCmd.DeleteObject acTable, "departments"

    DoCmd.DeleteObject acTable, "employees"

    DoCmd.DeleteObject acTable, "jobs"

    DoCmd.DeleteObject acTable, "operational"

    DoCmd.DeleteObject acTable, "punchs"

    DoCmd.DeleteObject acTable, "schedule"

    DoCmd.DeleteObject acTable, "weekdays"

On Error GoTo Err_cmdLinkDB_Click

    DoCmd.TransferDatabase acLink, "Microsoft Access", sOrigen, acTable, "departments", "departments"

    DoCmd.TransferDatabase acLink, "Microsoft Access", sOrigen, acTable, "employees", "employees"

    DoCmd.TransferDatabase acLink, "Microsoft Access", sOrigen, acTable, "jobs", "jobs"

    DoCmd.TransferDatabase acLink, "Microsoft Access", sOrigen, acTable, "operational", "operational"

    DoCmd.TransferDatabase acLink, "Microsoft Access", sOrigen, acTable, "punchs", "punchs"

    DoCmd.TransferDatabase acLink, "Microsoft Access", sOrigen, acTable, "schedule", "schedule"

    DoCmd.TransferDatabase acLink, "Microsoft Access", sOrigen, acTable, "weekdays", "weekdays"

    Access.Application.DoCmd.SelectObject acForm, Me.name, True

    Access.Application.DoCmd.RunCommand acCmdWindowHide

    MsgBox "The database has been linked correctly.", vbExclamation + vbOKOnly, TITLE_SOFTWARE

Exit_cmdLinkDB_Click:

    Exit Sub

Err_cmdLinkDB_Click:

    MsgBox "Link Error.", vbCritical + vbOKOnly, TITLE_SOFTWARE

    Resume Exit_cmdLinkDB_Click

End Sub