SharePoint路径未找到：VBA宏遍历文件复制单元格问题求助

核心问题原因 #

FileSystemObject（FSO）仅支持本地文件系统或映射的网络驱动器路径，无法直接解析SharePoint的HTTPS URL，这是导致"路径未找到"错误的根本原因。

修复方案 #

方法1：使用SharePoint WebDAV路径 #

将HTTPS路径转换为WebDAV格式，格式为：\\<站点域名>@SSL\DavWWWRoot\<站点相对路径>
你的原路径转换后为：
\\breeuropecom.sharepoint.com@SSL\DavWWWRoot\teams\UserAutomation\ Rollover project\Test 3 files

方法2：映射SharePoint文件夹为网络驱动器 #

手动将目标SharePoint文件夹映射为本地网络驱动器（如Z:），代码中直接使用驱动器路径（如Z:\Test 3 files）即可被FSO识别。

优化后的完整代码 #

以下代码修复了路径问题，同时实现了每个SharePoint文件生成3个本地新文件的需求，还优化了原代码的冗余操作：

Sub CopyFromSharePoint()
    Dim folder As Object
    Dim file As Object
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wbTemplate As Workbook
    Dim wsTemplate As Worksheet
    Dim myPath As String
    Dim newFileBase As String
    Dim newFile As String
    Dim i As Integer
    
    Application.ScreenUpdating = False
    
    ' 替换为WebDAV路径或映射驱动器路径
    myPath = "\\breeuropecom.sharepoint.com@SSL\DavWWWRoot\teams\UserAutomation\ Rollover project\Test 3 files"
    
    ' 仅创建一次FSO对象
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 提前打开模板文件，避免循环内重复打开
    Set wbTemplate = Workbooks.Open("C:\Users\sadyrovac2531\Downloads\test.xls")
    Set wsTemplate = wbTemplate.Sheets("F506a")
    
    Set folder = fso.GetFolder(myPath)
    For Each file In folder.Files
        If UCase(Right(file.Name, 5)) = ".XLSX" Then
            Set wb = Workbooks.Open(file.Path)
            Set ws = wb.Sheets("art166")
            
            ' 为每个SharePoint文件生成3个新文件
            newFileBase = "C:\Users\sadyrovac2531\Documents\" & Left(file.Name, Len(file.Name) - 5)
            For i = 1 To 3
                ' 复制模板数据
                wsTemplate.Cells(13, 7) = ws.Cells(1, 1)
                wsTemplate.Cells(14, 10) = ws.Cells(11, 2)
                wsTemplate.Cells(1, 18) = Replace(ws.Cells(2, 1), "Tax number: ", "")
                
                ' 生成带序号的文件名
                newFile = newFileBase & "_" & i & ".xlsx"
                ' 另存为新文件
                wbTemplate.SaveAs Filename:=newFile, FileFormat:=xlOpenXMLWorkbook
            Next i
            
            ' 关闭SharePoint工作簿
            wb.Close SaveChanges:=False
        End If
    Next file
    
    ' 关闭模板文件
    wbTemplate.Close SaveChanges:=False
    Application.ScreenUpdating = True
    
    Set fso = Nothing
    Set folder = Nothing
    Set wb = Nothing
    Set ws = Nothing
    Set wbTemplate = Nothing
    Set wsTemplate = Nothing
End Sub

额外注意事项 #

• 确保WebDAV服务已开启（Windows系统可通过"控制面板-程序-启用或关闭Windows功能"勾选"WebDAV客户端"）
• 若使用WebDAV路径仍报错，检查路径中的空格和特殊字符是否正确保留
• 确认当前用户对SharePoint文件夹有读写权限，且已登录SharePoint账号

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