使用VBA下载SharePoint Excel文件提示格式无效无法打开如何解决

云上老周

2026-8-27

问题描述

通过VBA实现SharePoint平台Excel文件自动下载时，下载流程提示执行成功，但本地打开生成的文件时触发报错：excel cannot open the file because the file format is invalid（Excel无法打开该文件，因为文件格式无效），同链接手动下载的文件可正常打开，异常仅在运行对应VBA代码时出现。

原始问题代码

Dim folderPath As String
    folderPath = Application.ActiveWorkbook.Path
    ThisWorkbook.Sheets(2).Activate
    Dim myURL As String
    myURL = Cells(2, 6).Value2
    Debug.Print myURL
    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject("Msxml2.ServerXMLHTTP.3.0")
    WinHttpReq.Open "GET", myURL, False
    WinHttpReq.Send
    Debug.Print WinHttpReq.Status
    myURL = WinHttpReq.responseBody
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile folderPath & "\REPORT\Data.xlsm", 2
       
        oStream.Close
        MsgBox "File Download Successful"
        downloadFile = 1

    Else
        MsgBox "File Download Failed"
        downloadeFile = 0

    End If

故障根因

代码使用的Msxml2.ServerXMLHTTP.3.0版本过低，默认不自动跟随SharePoint返回的302跳转响应，也不会自动携带当前系统/Office的身份认证凭证，最终写入本地的不是真实Excel二进制内容，而是SharePoint返回的登录页、权限提示页或者跳转提示页内容，仅被强制命名为.xlsm后缀，Excel无法识别格式。
代码存在冗余错误赋值：myURL = WinHttpReq.responseBody会将二进制响应体直接赋值给字符串类型的URL变量，属于无效逻辑。
未在写入文件前校验响应内容格式，无法提前识别非文件类的错误响应。
未提前检查目标存储路径\REPORT\是否存在，路径不存在时也会出现文件写入异常。

修复后可运行代码

Dim folderPath As String
folderPath = Application.ActiveWorkbook.Path
' 自动创建不存在的目标存储目录
If Dir(folderPath & "\REPORT\", vbDirectory) = "" Then
    MkDir folderPath & "\REPORT\"
End If

ThisWorkbook.Sheets(2).Activate
Dim myURL As String
myURL = Cells(2, 6).Value2
Debug.Print "待下载文件链接：" & myURL

Dim WinHttpReq As Object
' 替换为高版本XMLHTTP组件，支持重定向配置
Set WinHttpReq = CreateObject("MSXML2.XMLHTTP.6.0")
WinHttpReq.Open "GET", myURL, False
' 开启自动跟随重定向
WinHttpReq.Option(6) = True
WinHttpReq.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.1)"
WinHttpReq.Send

Debug.Print "请求响应状态码：" & WinHttpReq.Status
If WinHttpReq.Status = 200 Then
    ' 校验文件头：新版Office文件本质为zip压缩包，前4字节固定为50 4B 03 04
    Dim fileCheck As String
    fileCheck = LeftB(WinHttpReq.responseBody, 4)
    If fileCheck <> ChrB(&H50) & ChrB(&H4B) & ChrB(&H3) & ChrB(&H4) Then
        MsgBox "下载内容不是有效Excel文件，请检查链接访问权限"
        downloadFile = 0
        Set WinHttpReq = Nothing
        Exit Sub
    End If
    
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1 ' 二进制读写模式
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile folderPath & "\REPORT\Data.xlsm", 2 ' 2=覆盖同名文件
    oStream.Close
    Set oStream = Nothing
    
    MsgBox "File Download Successful"
    downloadFile = 1
Else
    MsgBox "File Download Failed，响应状态码：" & WinHttpReq.Status
    downloadFile = 0
End If
Set WinHttpReq = Nothing

注意事项

若SharePoint配置了严格的身份校验，可将组件替换为WinHttp.WinHttpRequest.5.1，并配置WinHttpReq.SetAutoLogonPolicy 0自动携带当前Windows登录凭证。
填写到单元格的下载链接需要是SharePoint文件的直接下载链接，不要带网页预览参数。

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