VBA访问SharePoint遇Runtime error 76路径未找到，如何自动修复连接？

问题场景 #

尝试创建基于宏的VBA程序访问SharePoint文件，执行移动、复制和数据处理操作。使用SharePoint文件夹的UNC路径时，程序时而正常运行，时而抛出Runtime error 76: path not found错误。报错的代码片段如下：

Sub ConvertXLSBtoXLSX()
    Dim SharePointPath As String
    Dim SharePointFile As String
    Dim folder As Object
    Dim file As Object
    Dim foundFile As Boolean
    Dim oldFilePath As String
    Dim newFilePath As String
    Dim FSO As New FileSystemObject

    Call AskForDate
    ' Specify the SharePoint file path and filename
    SharePointPath = "https://sites.xyz.com/sites/ABC/Shared Documents/Employee/"
    SharePointFile = "Data.xlsb"
    SharePointFolderPath = "\\sites.xyz.com@SSL\DavWWWRoot\sites\ABC\Shared Documents\Employee\"
    Const fileExtension As String = ".xlsb"
    
    Set folder = CreateObject("Scripting.FileSystemObject").GetFolder(SharePointFolderPath)
    For Each file In folder.Files
        If UCase(Right(file.Name, Len(fileExtension))) = UCase(fileExtension) Then
            oldFilePath = file.Path
            newFilePath = Left(oldFilePath, InStrRev(oldFilePath, "\")) & SharePointFile
            
            ' Rename the file
            Name oldFilePath As newFilePath
            
            foundFile = True
            Exit For
        End If
    Next file

End Sub

手动在文件资源管理器中打开SharePoint路径后再运行代码，程序可正常执行。推测是SharePoint的连接会定期断开，手动打开路径可恢复连接，需要实现自动化恢复连接，无需每次手动操作。

解决方案 #

方法1：用Shell触发路径访问 #

在代码开头添加逻辑，先通过Shell打开SharePoint UNC路径，触发系统建立连接，再执行后续操作：

Sub ConvertXLSBtoXLSX()
    Dim SharePointPath As String
    Dim SharePointFile As String
    Dim folder As Object
    Dim file As Object
    Dim foundFile As Boolean
    Dim oldFilePath As String
    Dim newFilePath As String
    Dim FSO As New FileSystemObject
    Dim shell As Object
    
    ' 先触发SharePoint连接
    Set shell = CreateObject("WScript.Shell")
    SharePointFolderPath = "\\sites.xyz.com@SSL\DavWWWRoot\sites\ABC\Shared Documents\Employee\"
    ' 后台打开资源管理器访问路径，触发连接建立
    shell.Run "explorer.exe " & Chr(34) & SharePointFolderPath & Chr(34), 0, False
    ' 短暂等待连接建立（可根据网络情况调整等待时间）
    Application.Wait Now + TimeValue("00:00:02")
    
    Call AskForDate
    SharePointPath = "https://sites.xyz.com/sites/ABC/Shared Documents/Employee/"
    SharePointFile = "Data.xlsb"
    Const fileExtension As String = ".xlsb"
    
    On Error Resume Next
    Set folder = CreateObject("Scripting.FileSystemObject").GetFolder(SharePointFolderPath)
    On Error GoTo 0
    
    If Not folder Is Nothing Then
        For Each file In folder.Files
            If UCase(Right(file.Name, Len(fileExtension))) = UCase(fileExtension) Then
                oldFilePath = file.Path
                newFilePath = Left(oldFilePath, InStrRev(oldFilePath, "\")) & SharePointFile
                
                Name oldFilePath As newFilePath
                
                foundFile = True
                Exit For
            End If
        Next file
    End If

End Sub

方法2：映射持久化网络驱动器 #

将SharePoint UNC路径映射为网络驱动器，设置为自动重连，让系统维护连接状态：

Sub MapSharePointDrive()
    Dim driveLetter As String
    Dim sharePointUNC As String
    Dim shell As Object
    
    driveLetter = "Z:"
    sharePointUNC = "\\sites.xyz.com@SSL\DavWWWRoot\sites\ABC\Shared Documents\Employee\"
    
    Set shell = CreateObject("WScript.Shell")
    ' 映射驱动器并设置持久化（下次开机自动重连）
    shell.Run "net use " & driveLetter & " " & Chr(34) & sharePointUNC & Chr(34) & " /persistent:yes", 0, True
    
    ' 后续代码可直接使用Z:\代替原UNC路径
End Sub

主程序中提前调用该映射方法，之后用驱动器路径访问SharePoint文件即可。

方法3：用API直接建立连接 #

通过Windows API函数WNetAddConnection2直接建立网络连接，无需打开资源管理器：

Private Type NETRESOURCE
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As String
    lpRemoteName As String
    lpComment As String
    lpProvider As String
End Type

Private Declare PtrSafe Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" ( _
    lpNetResource As NETRESOURCE, _
    ByVal lpPassword As String, _
    ByVal lpUsername As String, _
    ByVal dwFlags As Long) As Long

Private Const RESOURCE_CONNECTED As Long = &H1
Private Const RESOURCETYPE_DISK As Long = &H1
Private Const CONNECT_UPDATE_PROFILE As Long = &H1

Sub ConnectToSharePoint()
    Dim nr As NETRESOURCE
    Dim result As Long
    Dim sharePointUNC As String
    
    sharePointUNC = "\\sites.xyz.com@SSL\DavWWWRoot\sites\ABC\Shared Documents\Employee\"
    
    With nr
        .dwScope = RESOURCE_CONNECTED
        .dwType = RESOURCETYPE_DISK
        .lpRemoteName = sharePointUNC
    End With
    
    ' 使用当前用户凭据建立连接
    result = WNetAddConnection2(nr, vbNullString, vbNullString, CONNECT_UPDATE_PROFILE)
    
    If result <> 0 Then
        MsgBox "连接SharePoint失败，错误码：" & result
    End If
End Sub

在主程序开头调用ConnectToSharePoint函数，确保连接建立后再执行文件操作。

额外提示 #

• 调整等待时间：如果网络较慢，方法1中的Application.Wait等待时间可适当延长，避免连接未建立就执行后续代码。
• 错误处理：在访问SharePoint路径时添加错误捕获，若连接失败可重试连接逻辑。
• 权限验证：确保运行VBA的用户拥有SharePoint文件夹的访问权限，避免因权限不足导致路径错误。

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