如何用VBA实现SharePoint文件夹内Excel文件的搜索、打开、复制与关闭？

问题根源 #

直接用SharePoint的HTTP格式路径（如https://xxx.sharepoint.com/...）调用Dir函数会失效，因为Dir仅支持本地文件系统、映射网络驱动器或SharePoint的UNC格式路径，HTTP路径不属于这类可直接遍历的范畴。

可行解决方案 #

方案1：映射SharePoint文件夹为网络驱动器

1. 打开Windows资源管理器，点击「此电脑」→「映射网络驱动器」
2. 输入SharePoint文件夹的UNC路径（格式：\\<站点域名>.sharepoint.com@SSL\DavWWWRoot\<站点名>\<库名>\<文件夹路径>）
3. 勾选「登录时重新连接」，完成映射后即可像操作本地磁盘一样用Dir遍历文件。

方案2：直接使用UNC路径访问

无需映射驱动器，将HTTP路径转换为UNC格式即可：

• 原HTTP路径示例：https://contoso.sharepoint.com/sites/Operations/DailyReports/2024-09
• 对应UNC路径：\\contoso.sharepoint.com@SSL\DavWWWRoot\sites\Operations\DailyReports\2024-09

修改后的完整VBA代码 #

以下代码实现：选择SharePoint文件夹、遍历指定格式的Excel文件、读取数据并复制到当前工作簿、自动关闭源文件：

Sub ProcessSharePointDailyReports()
    Dim filePicker As FileDialog
    Dim targetFolder As String
    Dim fileName As String
    Dim sourceWB As Workbook
    Dim targetWS As Worksheet
    Dim lastRow As Long
    
    ' 设置目标工作表（当前工作簿的Sheet1，可根据需求修改）
    Set targetWS = ThisWorkbook.Sheets("Sheet1")
    
    ' 选择SharePoint文件夹
    Set filePicker = Application.FileDialog(msoFileDialogFolderPicker)
    With filePicker
        .InitialFileName = "\\contoso.sharepoint.com@SSL\DavWWWRoot\sites\Operations\DailyReports" ' 替换为你的UNC路径前缀
        .Title = "选择目标月份的日报文件夹"
        If .Show <> -1 Then Exit Sub ' 用户取消选择则退出
        targetFolder = .SelectedItems(1) & "\" ' 确保路径末尾有反斜杠
    End With
    
    ' 遍历文件夹中的Excel文件（仅处理.xlsx格式，可修改为.xls/.xlsm）
    fileName = Dir(targetFolder & "*.xlsx")
    
    Application.ScreenUpdating = False ' 禁用屏幕更新提升效率
    Application.DisplayAlerts = False ' 禁用警告弹窗
    
    Do While fileName <> ""
        ' 打开SharePoint上的Excel文件
        Set sourceWB = Workbooks.Open(targetFolder & fileName, ReadOnly:=True)
        
        ' 复制数据（示例：复制源文件Sheet1的A1:E100范围，可根据实际结构修改）
        lastRow = targetWS.Cells(targetWS.Rows.Count, "A").End(xlUp).Row + 1
        sourceWB.Sheets("Sheet1").Range("A1:E100").Copy targetWS.Cells(lastRow, "A")
        
        ' 关闭源文件，不保存修改
        sourceWB.Close SaveChanges:=False
        
        ' 继续下一个文件
        fileName = Dir
    Loop
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "所有日报数据已完成复制！", vbInformation
End Sub

代码关键点说明 #

1. 路径处理：必须使用UNC格式路径或映射驱动器路径，避免直接用HTTP路径
2. 文件遍历：用Dir(targetFolder & "*.xlsx")精准筛选Excel文件，避免无关文件
3. 效率优化：禁用屏幕更新和警告弹窗，批量处理时速度更快
4. 只读打开：打开源文件时设置ReadOnly:=True，避免锁定文件影响其他用户访问
5. 数据复制：根据实际日报的结构修改复制的范围和目标位置

原代码问题修正 #

你提供的示例代码存在两个核心问题：

• 使用了HTTP格式的SharePoint路径调用Dir，导致无法遍历文件
• 变量flag未定义，且ans = MsgBox(...)后错误判断flag = "No"，逻辑错误

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