为何Excel宏下载的SharePoint PDF文件损坏无法打开？

核心原因 #

你下载的3.88KB文件其实是SharePoint的权限验证页面/重定向跳转页面，而非实际PDF文件，根源有三点：

1. 链接类型错误：B列填写的是SharePoint文档的预览/详情页链接，不是直接的文件下载URL。这类链接会跳转到权限验证页面，URLDownloadToFile下载的是这个HTML页面，而非目标PDF。
2. 身份验证缺失：SharePoint Online需要现代身份验证，URLDownloadToFile默认不会自动传递当前Windows用户的凭据，服务器返回权限错误的HTML页面。
3. 编码兼容性问题：你使用了URLDownloadToFileA（ANSI编码版本），若URL包含中文、特殊字符，会导致链接解析失败，下载错误页面。

解决步骤 #

1. 获取正确的SharePoint直接下载链接 #

在SharePoint Online中：

• 右键目标PDF文件 → 选择「复制」→ 选择「复制直接下载链接」（部分版本叫「复制下载链接」）
• 替换B列原有链接，这类链接通常包含/download.aspx或直接指向文件二进制资源的地址。

2. 修改VBA代码（两种可选方案） #

方案一：修复URLDownloadToFile的编码与缓存问题

替换API声明为Unicode版本，添加缓存清理和文件有效性验证：

Option Explicit

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
  Alias "URLDownloadToFileW" ( _
    ByVal pCaller As LongPtr, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As LongPtr _
  ) As Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" _
  Alias "DeleteUrlCacheEntryW" (ByVal lpszUrlName As String) As Long

Public Const ERROR_SUCCESS As Long = 0
Public Const BINDF_GETNEWESTVERSION As Long = &H10

Sub DownloadFilesInExcel()
    Dim i As Long, ret As Long, sWAN As String, sLAN As String
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")
    
    For i = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row
        sLAN = "C:\Users\Prebek\Documents\MacroDownloads\" & ws.Cells(i, 1).Value
        sWAN = ws.Cells(i, 2).Value
        
        ' 清理缓存，避免重复下载旧的错误页面
        DeleteUrlCacheEntry sWAN
        
        ret = URLDownloadToFile(0&, sWAN, sLAN, BINDF_GETNEWESTVERSION, 0&)
        
        ' 增加文件大小验证，避免误判下载成功
        If ret = 0 Then
            If FileLen(sLAN) > 10 * 1024 Then ' 假设有效PDF至少10KB
                ws.Cells(i, 4) = "文件下载成功"
            Else
                ws.Cells(i, 4) = "下载失败：文件过小（可能是验证页面）"
                Kill sLAN ' 删除无效文件
            End If
        Else
            ws.Cells(i, 4) = "下载失败，错误码：" & ret
        End If
    Next i
End Sub

方案二：使用WinHTTP（更适配SharePoint身份验证）

WinHTTP可自动使用当前用户凭据，更适合现代身份验证场景：

Option Explicit

Sub DownloadSPFilesWithWinHTTP()
    Dim i As Long, sWAN As String, sLAN As String
    Dim ws As Worksheet
    Dim http As Object
    Set ws = Worksheets("Sheet1")
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    For i = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row
        sLAN = "C:\Users\Prebek\Documents\MacroDownloads\" & ws.Cells(i, 1).Value
        sWAN = ws.Cells(i, 2).Value
        
        ' 删除已存在的旧文件
        On Error Resume Next
        Kill sLAN
        On Error GoTo 0
        
        ' 发送请求并自动使用当前用户凭据
        http.Open "GET", sWAN, False
        http.SetAutoLogonPolicy 0
        http.Send
        
        If http.Status = 200 Then
            ' 将响应内容写入文件
            Dim fso As Object, ts As Object
            Set fso = CreateObject("Scripting.FileSystemObject")
            Set ts = fso.CreateTextFile(sLAN, True, True)
            ts.Write http.ResponseBody
            ts.Close
            
            ' 验证文件有效性
            If FileLen(sLAN) > 10 * 1024 Then
                ws.Cells(i, 4) = "文件下载成功"
            Else
                ws.Cells(i, 4) = "下载失败：文件无效"
                Kill sLAN
            End If
        Else
            ws.Cells(i, 4) = "请求失败，状态码：" & http.Status
        End If
    Next i
    
    Set http = Nothing
    Set fso = Nothing
End Sub

3. 额外注意事项 #

• 确保目标文件夹C:\Users\Prebek\Documents\MacroDownloads\已存在，可添加代码自动创建：If Not fso.FolderExists(Left(sLAN, InStrRev(sLAN, "\"))) Then fso.CreateFolder Left(sLAN, InStrRev(sLAN, "\"))
• 若SharePoint启用MFA（多因素认证），上述方案可能无法直接工作，需使用Microsoft Graph API生成带有效期的下载链接。

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