Excel VBA下载SharePoint文件遇异常问题求助

问题分析 #

1. 第一段代码（URLDownloadToFile）文件损坏原因
   该方法默认不会携带SharePoint Online所需的身份验证信息，偶尔成功是因为系统缓存了登录会话，但多数情况下下载的是SharePoint的登录跳转页面（HTML内容），而非实际Excel文件，导致文件损坏无法打开。

2. 第二段代码（XMLHTTP）访问被拒绝原因
   普通MSXML2.XMLHTTP对象无法自动复用当前用户的SharePoint登录凭证，且未配置有效的身份验证头，导致请求被SharePoint权限系统拦截。

可行解决方案 #

方案1：使用带凭证的ServerXMLHTTP（推荐，无需手动获取令牌） #

该方案利用MSXML2.ServerXMLHTTP对象自动使用当前Windows/Office登录用户的凭证，适用于已登录SharePoint Online的环境：

Sub DownloadSPFile()
    Dim spUrl As String
    Dim savePath As String
    Dim xhr As Object
    Dim stream As Object
    
    ' SharePoint文件的直接下载URL（替换为你的文件实际地址）
    spUrl = "https://sandvik.sharepoint.com/teams/PUMebaneDataHub/Shared%20Documents/Mebane%20Incident%20Intake%20Form.xlsx"
    savePath = "C:\temp1\Mebane Incident Intake Form.xlsx"
    
    ' 确保目标目录存在，不存在则创建
    If Dir("C:\temp1", vbDirectory) = "" Then
        MkDir "C:\temp1"
    End If
    
    ' 创建带凭证支持的ServerXMLHTTP对象
    Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    xhr.Open "GET", spUrl, False
    ' 配置忽略证书错误（可选，避免环境证书问题导致失败）
    xhr.SetOption 2, 13056
    ' 发送请求时自动使用当前用户登录凭证
    xhr.Send
    
    ' 检查请求状态并保存文件
    If xhr.Status = 200 Then
        Set stream = CreateObject("ADODB.Stream")
        stream.Open
        stream.Type = 1 ' 二进制模式
        stream.Write xhr.responseBody
        stream.SaveToFile savePath, 2 ' 覆盖已存在的目标文件
        stream.Close
        MsgBox "文件下载成功"
    Else
        MsgBox "下载失败，状态码：" & xhr.Status & vbCrLf & "响应信息：" & xhr.responseText
    End If
    
    ' 释放对象
    Set xhr = Nothing
    Set stream = Nothing
End Sub

方案2：修复URLDownloadToFile的核心问题 #

如果坚持使用URLDownloadToFile，需确保两个关键条件：

• 使用SharePoint的直接下载链接：右键文件→复制→复制链接→选择「直接下载」选项，获取正确的下载地址，而非浏览器打开的预览链接。
• 确保系统已缓存有效登录会话（比如提前打开SharePoint网站并保持登录状态），但该方法稳定性远不如方案1。

额外注意事项 #

• 确认你的账户对C:\temp1目录有写入权限，若没有，可更换到个人目录（如C:\Users\[你的用户名]\Documents\temp1）。
• 若环境是未加入域的机器且未登录Office桌面客户端，可能需要手动配置OAuth2令牌，但步骤复杂，优先推荐方案1。

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