"Disconnected Network Drive" 在我的电脑

"Disconnected Network Drive" in My Computer

我们使用 VPN 连接到工作网络。我有一个映射网络驱动器,连接后立即在“我的电脑”中显示 "Disconnected Network Drive"。在这种状态下,我 运行 一个 VBA 例程:

Dim dr As String: dr = "F:\T\"
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(dr) Then
    Call fso.CreateFolder(dr)
End If

即使文件夹确实存在,fso 认为它不存在,所以它尝试创建文件夹并抛出错误:运行-time error 76: Path not found。当然找不到了,因为它处于断开状态。使用该网络驱动器的任何其他操作也将失败。

所以我打开我的电脑,手动双击网络驱动器。它连接得很好,当 运行 再次输入代码时我不再收到错误。但这是有问题的。我需要代码中的解决方案来自动连接网络驱动器。

可能的解决方案1: 只需使用UNC 路径而不是映射的驱动器号。问题是我不知道路径是什么。我也不想使用 UNC;代码需要灵活地与驱动器映射到的任何地方一起工作。这是黄铜的政策。

可能的解决方案 2: 使用 Net Use 或 WshNetwork 重新映射网络驱动器。同样,这不太可能,因为我不知道 UNC 路径是什么或将是什么。

可能方案三: Connect using ShellExecute While this would work, it isn't really palatable as it opens a window to explore the folder (could use SW_HIDE to avoid showing the window, but then how would I close it?). Furthermore it doesn't connect instantly. I would need a delay of uncertain length to make this work. Not a good answer. MSDN ShellExecute Function

那么有更好的解决办法吗?如何在等待驱动器连接到 return 并在无法连接时抛出错误?

我需要它同时适用于 VBScript 和 VBA。

Slugster 关于获取映射的 UNC 值的建议很好。这是我的解决方案,改编自 this answer 这适用于 VBScript 和 VBA。

Sub testget()
    Debug.Print getUNC("F:\T\")
End Sub

Function getUNC(dir)

    Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim sDrive: sDrive = fso.GetDriveName(dir)
    Set fso = Nothing

    Dim sMap: sMap = GetMappedDrive(sDrive)
    If sMap <> "" And sDrive <> sMap Then
        getUNC = Replace(dir, sDrive, sMap)
    Else
        getUNC = dir
    End If

End Function

Function GetMappedDrive(sDrive)
    Dim wshNetwork: Set wshNetwork = CreateObject("WScript.Network")
    Dim oDrives: Set oDrives = wshNetwork.EnumNetworkDrives
    Dim i
    For i = 0 To oDrives.Count - 1 Step 2
        If UCase(oDrives.Item(i)) = UCase(sDrive) Then
            GetMappedDrive = oDrives.Item(i + 1)
            Exit For
        End If
    Next
    Set oDrives = Nothing
    Set wshNetwork = Nothing
End Function