Excel 2016 VBA实现记忆映射网络驱动器自动重连解决方案咨询

解决方案 #

你之前的方案失效有两个核心原因：

• fso.DriveExists仅读取Windows本地缓存的驱动器状态，不会主动发起网络连接请求，半离线的映射驱动器会被误判为不存在
• 直接调用重映射接口报错，是因为半断开的网络连接在系统中存在残留会话记录，常规操作会触发冲突

方案1：通过Dir访问触发系统自动重连（推荐，无感知，90%场景可用）

该方案的触发逻辑和用户手动点击盘符完全一致，会主动请求服务器建立连接，绕过本地缓存：

' DriveLetter传入格式为带冒号的盘符，例如 "A:"
Function CheckAndWakeNetworkDrive(ByVal DriveLetter As String) As Boolean
    On Error Resume Next
    Dim temp As String
    ' 访问盘符根目录触发重连
    temp = Dir(DriveLetter & "\", vbDirectory)
    If Err.Number = 0 Then
        CheckAndWakeNetworkDrive = True
    Else
        Err.Clear
        ' 网络延迟场景下等待1秒重试
        Application.Wait Now + TimeValue("00:00:01")
        temp = Dir(DriveLetter & "\", vbDirectory)
        CheckAndWakeNetworkDrive = (Err.Number = 0)
    End If
    On Error GoTo 0
End Function

使用时在你访问网络资源前先调用该函数判断即可。

方案2：改良版重映射逻辑（方案1失效时使用）

新增强制参数处理残留会话，忽略无意义的报错：

' DriveLetter: 带冒号的盘符，例如 "A:"
' UNCPath: 映射对应的网络路径，例如 "\\servername\shares"
Sub RemapNetworkDrive(ByVal DriveLetter As String, ByVal UNCPath As String)
    Dim nwo As WshNetwork
    Set nwo = New WshNetwork
    On Error Resume Next
    ' 第二个参数=True：强制断开所有占用连接；第三个参数=True：同步更新用户配置
    nwo.RemoveNetworkDrive DriveLetter, True, True
    Err.Clear ' 忽略"连接不存在"的非致命报错
    ' 第三个参数=True：将映射保存到用户配置，和组策略规则一致
    nwo.MapNetworkDrive DriveLetter, UNCPath, True
    On Error GoTo 0
    Set nwo = Nothing
End Sub

方案3：后台模拟用户点击盘符（极端场景兜底）

完全模拟用户手动打开资源管理器点击盘符的操作，窗口全程隐藏，用户无感知：

' DriveLetter传入格式为带冒号的盘符，例如 "A:"
Sub WakeDriveByShell(ByVal DriveLetter As String)
    Dim shell As Object
    Set shell = CreateObject("WScript.Shell")
    ' 第二个参数为0表示隐藏窗口，用户看不到弹出的资源管理器界面
    shell.Run "explorer.exe " & DriveLetter, 0, False
    ' 等待1秒给系统足够时间完成重连，可根据实际网络情况调整时长
    Application.Wait Now + TimeValue("00:00:01")
    Set shell = Nothing
End Sub

内容的提问来源于stack exchange，提问作者Glenn G