如何用VBA重新连接共享驱动器解决工作簿链接无法打开问题

核心逻辑 #

Windows对未访问过的共享目录会处于“断开”状态，即便用UNC路径也可能触发连接验证问题。通过VBA模拟访问操作，可触发系统自动建立共享连接，避免“文件未找到”错误。

两种实现代码 #

方案1：模拟手动打开共享目录（直观触发连接） #

Sub ReconnectSharedDrive()
    Dim uncPath As String
    uncPath = "\\YourServer\SharedFolder" '替换为你的共享目录UNC路径
    
    On Error Resume Next
    '调用资源管理器打开共享目录，触发系统连接
    Shell "explorer.exe " & Chr(34) & uncPath & Chr(34), vbNormalFocus
    
    '验证连接状态
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(uncPath) Then
        Debug.Print "共享目录已成功连接"
    Else
        MsgBox "连接失败，请检查路径或权限", vbCritical
    End If
    Set fso = Nothing
    On Error GoTo 0
End Sub

方案2：后台验证并连接（无界面） #

'声明Windows API用于路径检查
Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long

Sub VerifyAndReconnect()
    Dim uncPath As String
    uncPath = "\\YourServer\SharedFolder" '替换为实际UNC路径
    
    '检查路径是否不可访问
    If PathFileExists(uncPath) = 0 Then
        '执行net use命令建立持久连接
        Shell "net use " & Chr(34) & uncPath & Chr(34) & " /persistent:yes", vbHide
        '等待1秒让系统完成连接
        Application.Wait Now + TimeValue("00:00:01")
    End If
    
    '二次验证并执行后续操作
    If PathFileExists(uncPath) Then
        '这里可添加打开目标文件的代码
        Debug.Print "共享路径已可用"
    Else
        MsgBox "无法连接共享目录，请检查网络或权限", vbExclamation
    End If
End Sub

使用提示 #

• 替换代码中的\\YourServer\SharedFolder为真实的共享目录UNC路径
• 可将代码放入工作簿的Workbook_Open事件，实现打开时自动执行：

Private Sub Workbook_Open()
    VerifyAndReconnect '或调用ReconnectSharedDrive
End Sub

• 需确保用户拥有共享目录访问权限，且启用VBA宏（在Excel信任中心设置）

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