retrieve current path from file saved on server - vba

Question

How I can retrieve the current path of current db?
I've one AC07 program, to distribute it I save one copy on the intranet server, how to copy this program into our PC and then use it?
Always some people open the file directly on server.
When the file is open one form star automatically, in this form I put this code:
Private Sub Form_Load()
On Error GoTo ErrorHandler
Dim StrServer As String
StrServer = "\\itbgafs01\Comune\Dashboard\"
If GetDBPath() = StrServer Then
MsgBox "You can't open this file from server" & vbCrLf & _
"save one copy on you PC, and use those", vbCritical, "Dashboard.info"
Application.Quit
End If
Public Function GetDBPath() As String
Dim strFullPath As String
Dim I As Integer
strFullPath = CurrentDb().Name
For I = Len(strFullPath) To 1 Step -1
If Mid(strFullPath, I, 1) = "\" Then
GetDBPath = left(strFullPath, I)
Exit For
End If
Next
End Function
My problem is: some PC are mapped on drive H: the server directory then the path result is H:\Comune\Dashboard\ and not \\itbgafs01\\Dashboard\.
How I can retrieve the absolute path?
First I think to use more if like:
Private Sub Form_Load()
On Error GoTo ErrorHandler
Dim StrServer As String
Dim StrMaph As String
StrServer = "\\itbgafs01\Comune\Dashboard\"
StrMaph = "H:\Comune\Dashboard\"
MsgBox StrServer & vbCrLf & _
StrMaph & vbCrLf & _
GetDBPath()
If GetDBPath() = StrServer Or GetDBPath() = StrMaph Then
MsgBox "Non puoi aprire il file sul server" & vbCrLf & _
"copialo sul tuo pC ed avvia il programma da li", vbCritical, "Dashboard.info"
Application.Quit
End If
Is there another way to do it?

Answer 1

You can use the Scripting Runtime to get the UNC path of the drive then replace it in the currentDb.Name.
E.g.:
Sub blah()
Debug.Print GetUNCPath(CurrentDb.Name)
End Sub
Function GetUNCPath(path As String) As String
Dim fso As Object, shareName
Set fso = CreateObject("Scripting.FileSystemObject")
shareName = fso.GetDrive( _
fso.GetDriveName(path)).shareName
'sharename is empty if it wasn't a network mapped drive (e.g. local C: drive)
If shareName <> "" Then
GetUNCPath = shareName & Right(path, Len(path) - InStr(1, path, "\"))
Else
GetUNCPath = path
End If
End Function
Edit: alternatively you can use a call to the WinAPI to get the info: https://support.microsoft.com/en-us/kb/160529