Vba 从服务器上保存的文件中检索当前路径

如何检索当前数据库的当前路径？ 我有一个AC07程序，为了分发它，我在intranet服务器上保存了一个副本，如何将这个程序复制到我们的PC上，然后使用它？ 总是有人直接在服务器上打开文件

当文件自动打开一个表单星时，我在该表单中输入以下代码：

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

我的问题是：某些PC映射到驱动器H:服务器目录，然后路径结果是

H:\Comune\Dashboard\

，而不是

\\itbgafs01\\Dashboard\

。 如何检索绝对路径？ 首先，如果喜欢，我想使用更多：

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

---

还有其他方法吗？

您可以使用脚本运行时获取驱动器的UNC路径，然后将其替换为currentDb.Name

例如：

Sub-blah（）
Debug.Print GetUNCPath（CurrentDb.Name）
端接头
函数GetUNCPath（路径为字符串）为字符串
Dim fso作为对象，shareName
设置fso=CreateObject（“Scripting.FileSystemObject”）
shareName=fso.GetDrive（_
fso.GetDriveName（路径））.shareName
'如果不是网络映射驱动器（例如本地C:驱动器），则sharename为空
如果共享名为“”，则
GetUNCPath=shareName&Right（路径，Len（路径）-InStr（1，路径，“\”）
其他的
GetUNCPath=path
如果结束
端函数

---

编辑：或者，您可以使用对WinAPI的调用来获取信息：

您可以使用API调用来检索映射驱动器的服务器。但是你目前使用双重检查的方法很简单，那么为什么不坚持使用它呢？@Gustav，是的，双重选择的方法很好，但是你知道的一些公司拥有1000多用户，很容易有人将服务器目录映射到S:或Z:或X:。。。。。。我太热心了（从谷歌翻译过来，这个词真的存在于英语中？？？）谢谢，你只命名了驱动程序H。那么你应该有一个API方法——就像Cor.@Fabrizio Thank提供的方法一样——很高兴它有所帮助。请将此标记为答案，以供其他人将来参考。

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