Как задать относительный путь к файлу БД?

Sub tConnect()
    Dim cat As Object, tbl As Object, PathDB, p
    Set cat = CreateObject("ADOX.Catalog")
    Set tbl = CreateObject("ADOX.Table")
    
    cat.ActiveConnection = CurrentProject.Connection
    PathDB = CurrentProject.path               'Текущий путь к БД с формами
    p = "ИмяТабличнойБД.mdb"                   'Имя табличной базы
    For Each tbl In cat.Tables
        If tbl.Type = "LINK" Then
            tbl.Properties("Jet OLEDB:Link Datasource") = PathDB & "\" & p
        End If
    Next
End Sub

Private Sub Form_Open(Cancel As Integer)
    Dim s, rst As dao.Recordset, tbl
    Set db = CurrentDb
    tbl = "ИмяТаблицы"       'Имя обязательной линкованной таблицы
    s = "select * from [" & tbl & "]"
    
    On Error GoTo errend
    Set rst = CurrentDb.OpenRecordset(s)
    
errNo:
    Exit Sub                 'Ошибок нет, все линкованные таблицы подключены
errend:
    Select Case err.Number
        Case 3024            'Не удается найти файл
            tConnect         'подключаем процедуру перелинковки
        Case Else
            msgbox "Ошибка: " & Err.Number & " " & Err.Description 'Другие ошибки
    End Select
    Resume errNo
End Sub

Function FuncLink()
 Dim Db As DAO.Database, _
     Rst As DAO.Recordset, _
     S As String, _
     SN As String
 Set Db = CurrentDb
 Set Rst = Db.OpenRecordset("SELECT Name,Database FROM MSysObjects WHERE Type=6")
 S = CurrentProject.Path & "\"
 With Rst
  Do Until .EOF
   SN = S & Split(!Database, "\")(UBound(Split(!Database, "\")))
   If Db(!Name).Connect <> SN Then
    Db(!Name).Connect = SN
    Db(!Name).RefreshLink
   End If
   .MoveNext
  Loop
 End With
End Function

Function FuncLink()
 Dim Db As DAO.Database, _
     Rst As DAO.Recordset, _
     S As String, _
     SN As String
 Set Db = CurrentDb
 Set Rst = Db.OpenRecordset("SELECT Name,Database FROM MSysObjects WHERE Type=6")
 S = Left(CurrentProject.Path, InStrRev(CurrentProject.Path, "\"))
 With Rst
  Do Until .EOF
   SN = S & Split(!Database, "\")(UBound(Split(!Database, "\")))
   If Db(!Name).Connect <> SN Then
    Db(!Name).Connect = SN
    Db(!Name).RefreshLink
   End If
   .MoveNext
  Loop
 End With
End Function

' было
S = CurrentProject.Path & "\"
' стало
S = Left(CurrentProject.Path, InStrRev(CurrentProject.Path, "\"))

Function FuncLink()
 Dim Db As DAO.Database, _
     Rst As DAO.Recordset, _
     S As String, _
     SN As String
 Set Db = CurrentDb
 Set Rst = Db.OpenRecordset("SELECT Name,Database FROM MSysObjects WHERE Type=6")
 S = Left(CurrentProject.Path, InStrRev(CurrentProject.Path, "\"))
 With Rst
  Do Until .EOF
   SN = ";DATABASE=" & S & Split(!Database, "\")(UBound(Split(!Database, "\")))
   If Db(!Name).Connect <> SN Then
    Db(!Name).Connect = SN
    Db(!Name).RefreshLink
   End If
   .MoveNext
  Loop
 End With
End Function

' было
SN = S & Split(!Database, "\")(UBound(Split(!Database, "\")))
' стало
SN = ";DATABASE=" & S & Split(!Database, "\")(UBound(Split(!Database, "\")))