如何从SharePoint同一链接下载多个文件？附单文件下载VBA代码

阿华AIGC实验室

2026-5-27

从SharePoint批量下载文件的VBA解决方案

嘿，我来帮你把这段代码改造成能批量下载SharePoint文件的版本！基于你现有的URLDownloadToFile函数，我们可以通过循环处理多个文件的方式实现需求，下面给你两种实用的方案：

方案一：已知要下载的文件名（精准批量下载）

如果你明确知道要下载的所有文件名，直接把它们放进列表循环处理就好，代码改造如下：

' 保留你的API声明
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Dim Ret As Long

Sub Batch_Download_From_SharePoint()
    Dim strBaseURL As String
    Dim strSavePath As String
    Dim fileList As Variant
    Dim fileName As Variant
    Dim sDate As Date
    
    ' 替换成你的实际参数
    sDate = Date ' 或者你指定的目标日期
    strBaseURL = "https://your-sharepoint-site/folder-path/" ' SharePoint文件夹的基础链接，末尾加/
    strSavePath = "C:\Your\Local\Save\Folder\" ' 本地保存路径，末尾加/
    
    ' 定义要下载的文件名列表，按需添加或修改
    fileList = Array( _
        "report.Denial." & Format(sDate, "yyyymmdd") & ".xlsx", _
        "report.Approval." & Format(sDate, "yyyymmdd") & ".xlsx", _
        "report.Pending." & Format(sDate, "yyyymmdd") & ".xlsx" _
    )
    
    ' 循环下载每个文件
    For Each fileName In fileList
        Dim strFullURL As String
        Dim strFullSavePath As String
        
        strFullURL = strBaseURL & fileName
        strFullSavePath = strSavePath & fileName
        
        ' 调用下载函数
        Ret = URLDownloadToFile(0, strFullURL, strFullSavePath, 0, 0)
        
        ' 反馈下载结果
        If Ret = 0 Then
            MsgBox fileName & " 下载成功！", vbInformation
        Else
            MsgBox fileName & " 下载失败，错误代码：" & Ret, vbExclamation
        End If
    Next fileName
End Sub

使用说明：把要下载的文件名全部放进fileList数组，代码会自动逐个构建完整的SharePoint链接和本地保存路径，完成批量下载。

方案二：自动获取文件夹下所有文件（全量下载）

如果你不知道具体文件名，想下载整个SharePoint文件夹里的所有文件，可以通过SharePoint的REST API先获取文件列表，再循环下载：

' 保留你的API声明
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Dim Ret As Long

Sub Download_All_Files_From_SharePoint_Folder()
    Dim strSPFolderAPI As String
    Dim strLocalSavePath As String
    Dim objXMLHTTP As Object
    Dim objScript As Object
    Dim fileResults As Variant
    Dim singleFile As Variant
    Dim strFullURL As String
    Dim strFullSavePath As String
    
    ' 替换成你的实际参数
    strSPFolderAPI = "https://your-sharepoint-site/_api/web/getfolderbyserverrelativeurl('/sites/your-site/target-folder')/files"
    strLocalSavePath = "C:\Your\Local\Save\Folder\"
    
    ' 创建文件夹（如果不存在）
    If Dir(strLocalSavePath, vbDirectory) = "" Then MkDir strLocalSavePath
    
    ' 调用SharePoint REST API获取文件列表
    Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
    objXMLHTTP.Open "GET", strSPFolderAPI, False
    objXMLHTTP.setRequestHeader "Accept", "application/json;odata=verbose"
    objXMLHTTP.send
    
    ' 解析返回的JSON数据
    Set objScript = CreateObject("Microsoft.JScript")
    objScript.execScript "var data = " & objXMLHTTP.responseText, "JScript"
    fileResults = objScript.data.d.results
    
    ' 循环下载每个文件
    For Each singleFile In fileResults
        strFullURL = "https://your-sharepoint-site" & singleFile.ServerRelativeUrl
        strFullSavePath = strLocalSavePath & singleFile.Name
        
        Ret = URLDownloadToFile(0, strFullURL, strFullSavePath, 0, 0)
        
        ' 打印下载日志到立即窗口
        If Ret = 0 Then
            Debug.Print singleFile.Name & " 下载成功"
        Else
            Debug.Print singleFile.Name & " 下载失败，错误代码：" & Ret
        End If
    Next singleFile
    
    MsgBox "全量下载完成！", vbInformation
    
    ' 释放对象
    Set singleFile = Nothing
    Set fileResults = Nothing
    Set objScript = Nothing
    Set objXMLHTTP = Nothing
End Sub

使用说明：需要替换strSPFolderAPI里的站点地址和文件夹路径，API格式为https://你的站点域名/_api/web/getfolderbyserverrelativeurl('/sites/站点名/文件夹路径')/files，代码会自动获取该文件夹下的所有文件并下载到本地。