Private Const OBJ_NAME = "modSystem"
'****************************************************************************************
' Function Name: appPath
'
' Description:
' Returns the absolute path of the MS Access database in use.
'
' NOTE:
' The returned path does not include the trailing '\' at the end.
' i.e. C:\Development\...\myfolde
'****************************************************************************************
Public Function appPath() As String
Dim ErrMsg As String
Dim ErrNo As Long
Dim dbPath As String
Dim path As String
Dim pos As Integer
On Error GoTo proc_err
'Obtain the full path to the MS Access DB in use. Keep in mind that
'i.e. C:\...\mydb.mdb
dbPath = CurrentDb.Name
'Continue if the a path was returned
If Len(dbPath) > 0 Then
'Iterate through the path string until the last '\' character
'has been reached
pos = InStr(dbPath, "\")
Do While pos > 0
'Save the potiential sought path
'NOTE:
' Change pos -1 to pos to include the trailing '\'
' at the end of the returned path
path = Left(dbPath, pos - 1)
'Conduct a check to determine if the last '\' has been reach
'in db's path string
pos = InStr(pos + 1, dbPath, "\")
Loop
'Now, exclude the name of the database name and return
'only the path
Else
'No path was retrieved
path = ""
End If
'Return path to calling function
appPath = path
Exit Function
proc_err:
ErrNo = Err.Number
ErrMsg = Err.Description
On Error Resume Next
appPath = ""
Err.Raise ErrNo, OBJ_NAME & ".appPath", ErrMsg
End Function
I hope this helps. Cheers.
MMS
