"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
我们使用 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