如何对SharePoint文件夹中所有工作簿运行宏并保存至原位置？

方法一：直接通过HTTPS路径+HTML解析获取文件列表 #

该方法无需映射驱动器，直接通过HTTP请求获取SharePoint文件夹的文件列表，逐个处理文件：

Sub BatchRunMacroOnSharePointFiles()
    Dim spFolderPath As String
    Dim fileUrl As String
    Dim fileName As String
    Dim wb As Workbook
    Dim saveFileName As String
    
    ' 替换为你的SharePoint文件夹HTTPS路径，末尾需加斜杠
    spFolderPath = "https://your-sharepoint-site/sites/your-site/Shared%20Documents/TargetFolder/"
    
    Dim xmlHttp As Object
    Dim htmlDoc As Object
    Dim linkElements As Object
    Dim linkElement As Object
    
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    xmlHttp.Open "GET", spFolderPath, False
    xmlHttp.Send
    
    Set htmlDoc = CreateObject("HTMLFile")
    htmlDoc.body.innerHTML = xmlHttp.responseText
    
    Set linkElements = htmlDoc.getElementsByTagName("a")
    
    For Each linkElement In linkElements
        fileUrl = linkElement.href
        ' 筛选Excel文件，可根据需求添加/移除扩展名
        If InStr(fileUrl, ".xlsx") > 0 Or InStr(fileUrl, ".xls") > 0 Then
            ' 跳过已处理的带summary后缀的文件
            If InStr(fileUrl, "summary.xlsx") = 0 And InStr(fileUrl, "summary.xls") = 0 Then
                ' 打开SharePoint上的Excel文件
                Set wb = Workbooks.Open(fileUrl)
                
                ' 运行你的报表生成宏，替换为实际宏名称
                Call YourReportMacroName
                
                ' 生成带summary后缀的文件名
                fileName = Split(wb.Name, ".")(0) & "_summary." & Split(wb.Name, ".")(1)
                saveFileName = spFolderPath & fileName
                
                ' 根据文件格式保存
                If LCase(Split(wb.Name, ".")(1)) = "xlsx" Then
                    wb.SaveAs Filename:=saveFileName, FileFormat:=xlOpenXMLWorkbook
                Else
                    wb.SaveAs Filename:=saveFileName, FileFormat:=xlExcel8
                End If
                
                wb.Close SaveChanges:=False
            End If
        End If
    Next linkElement
    
    ' 清理对象
    Set linkElement = Nothing
    Set linkElements = Nothing
    Set htmlDoc = Nothing
    Set xmlHttp = Nothing
    Set wb = Nothing
    
    MsgBox "批量处理完成！"
End Sub

注意事项 #

• 替换代码中的spFolderPath为你的实际SharePoint文件夹HTTPS路径
• 将YourReportMacroName替换为你要运行的宏的名称
• 此方法适用于无需MFA（多因素认证）的SharePoint站点，若有MFA，建议使用方法二

方法二：使用WebDAV UNC路径（更稳定，支持MFA） #

将SharePoint HTTPS路径转换为WebDAV格式的UNC路径，即可用常规文件系统遍历方法处理，兼容性更好：

路径转换规则 #

原HTTPS路径：https://contoso.sharepoint.com/sites/Sales/Shared%20Documents/Reports/
转换为WebDAV UNC路径：\\contoso.sharepoint.com@SSL\DavWWWRoot\sites\Sales\Shared Documents\Reports\

• 把https://替换为\\
• 域名后追加@SSL
• 路径中的/替换为\，并在域名后添加\DavWWWRoot\
• 将%20替换为空格

实现代码 #

Sub BatchRunMacroOnSharePointFiles_WebDAV()
    Dim uncFolderPath As String
    Dim filePath As String
    Dim wb As Workbook
    Dim saveFileName As String
    Dim fso As Object
    
    ' 替换为转换后的WebDAV UNC路径
    uncFolderPath = "\\contoso.sharepoint.com@SSL\DavWWWRoot\sites\Sales\Shared Documents\Reports\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 遍历文件夹中的Excel文件
    filePath = Dir(uncFolderPath & "*.xls*")
    
    Do While filePath <> ""
        ' 跳过已处理的文件
        If InStr(filePath, "summary") = 0 Then
            Set wb = Workbooks.Open(uncFolderPath & filePath)
            
            ' 运行你的报表宏
            Call YourReportMacroName
            
            ' 生成保存文件名
            saveFileName = fso.GetBaseName(filePath) & "_summary." & fso.GetExtensionName(filePath)
            
            ' 保存回SharePoint文件夹
            If fso.GetExtensionName(filePath) = "xlsx" Then
                wb.SaveAs Filename:=uncFolderPath & saveFileName, FileFormat:=xlOpenXMLWorkbook
            Else
                wb.SaveAs Filename:=uncFolderPath & saveFileName, FileFormat:=xlExcel8
            End If
            
            wb.Close SaveChanges:=False
        End If
        
        filePath = Dir
    Loop
    
    Set fso = Nothing
    Set wb = Nothing
    
    MsgBox "批量处理完成！"
End Sub

注意事项 #

• 运行前确保已手动访问过目标SharePoint文件夹，让Windows保存凭据（MFA环境下需完成一次认证）
• 本地部署的SharePoint（On-Premises）路径格式可能为\\your-sp-server\sites\your-site\Shared Documents\TargetFolder\，无需添加@SSL和DavWWWRoot

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