VBA代码本地保存后上传SharePoint失败问题求助

问题根源 #

你的代码提示上传成功但实际无文件，核心问题是直接POST到SharePoint文件URL的方式错误，SharePoint不支持这种简单的表单上传，需要使用官方的REST API、WebDAV协议，或者直接利用Office内置的SharePoint路径保存能力。

解决方案1：直接用SaveAs保存到SharePoint（最简便） #

Office支持直接将文件保存到SharePoint文档库路径，无需额外HTTP请求，代码简洁且稳定：

Sub SaveToLocalAndSharePoint()
    Dim wb As Workbook
    Dim todayDate As String
    Dim fileName As String
    Dim localPath As String
    Dim sharePointDocLibPath As String
    
    Set wb = ActiveWorkbook
    todayDate = Format(Date, "YYYYMMDD")
    fileName = "DepoTest_" & todayDate & ".xlsm"
    
    ' 本地保存路径（替换为你的实际路径）
    localPath = "C:\YourLocalFolder\" & fileName
    ' SharePoint文档库直接路径（可从浏览器复制文档库内的文件路径替换）
    sharePointDocLibPath = "https://yourcompany.sharepoint.com/sites/yoursite/Shared Documents/" & fileName
    
    ' 保存到本地
    On Error GoTo LocalSaveError
    Application.DisplayAlerts = False
    wb.SaveAs Filename:=localPath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.DisplayAlerts = True
    
    ' 直接保存到SharePoint（Office自动处理认证）
    On Error GoTo SPError
    wb.SaveCopyAs Filename:=sharePointDocLibPath
    
    MsgBox "本地和SharePoint保存均成功！"
    Exit Sub
    
LocalSaveError:
    Application.DisplayAlerts = True
    MsgBox "本地保存失败：" & Err.Description
    Exit Sub
    
SPError:
    MsgBox "SharePoint上传失败：" & Err.Description
End Sub

解决方案2：用SharePoint REST API上传（适合自定义逻辑场景） #

如果必须用HTTP请求，需调用SharePoint的Files REST API，同时正确处理认证和二进制数据：

Sub SaveLocalAndUploadViaREST()
    Dim wb As Workbook
    Dim todayDate As String, fileName As String
    Dim localPath As String, tempFilePath As String
    Dim fileData() As Byte
    Dim http As Object
    Dim spSiteUrl As String, spDocLibRelativePath As String
    Dim apiUrl As String
    
    Set wb = ActiveWorkbook
    todayDate = Format(Date, "YYYYMMDD")
    fileName = "DepoTest_" & todayDate & ".xlsm"
    localPath = "C:\YourLocalFolder\" & fileName
    tempFilePath = Environ("TEMP") & "\" & fileName
    
    ' SharePoint站点和文档库信息（替换为你的实际信息）
    spSiteUrl = "https://yourcompany.sharepoint.com/sites/yoursite"
    spDocLibRelativePath = "/sites/yoursite/Shared Documents" ' 站点相对路径
    
    ' 本地保存并生成临时文件
    On Error GoTo LocalSaveError
    Application.DisplayAlerts = False
    wb.SaveAs Filename:=localPath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    wb.SaveCopyAs tempFilePath
    Application.DisplayAlerts = True
    
    ' 读取二进制文件内容
    fileData = ReadBinaryFile(tempFilePath)
    
    ' 构建REST API请求地址
    apiUrl = spSiteUrl & "/_api/web/getfolderbyserverrelativeurl('" & Replace(spDocLibRelativePath, "'", "''") & "')/files/add(overwrite=true, url='" & Replace(fileName, "'", "''") & "')"
    
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open "POST", apiUrl, False
    ' 自动使用当前用户凭据认证（适用于AD或已登录M365的场景）
    http.SetAutoLogonPolicy 0
    http.setRequestHeader "Accept", "application/json;odata=verbose"
    http.setRequestHeader "Content-Type", "application/vnd.ms-excel.sheet.macroEnabled.12"
    http.Send fileData ' 直接发送二进制数据，避免转码破坏文件
    
    If http.Status >= 200 And http.Status < 300 Then
        MsgBox "本地保存+SharePoint上传成功！"
    Else
        MsgBox "SharePoint上传失败，状态码：" & http.Status & vbCrLf & http.ResponseText
    End If
    
    ' 清理临时文件
    On Error Resume Next
    Kill tempFilePath
    On Error GoTo 0
    Exit Sub
    
LocalSaveError:
    Application.DisplayAlerts = True
    MsgBox "本地保存失败：" & Err.Description
    Exit Sub
End Sub

Function ReadBinaryFile(filePath As String) As Byte()
    Dim fileNumber As Integer, fileLength As Long
    Dim fileData() As Byte
    
    fileNumber = FreeFile
    Open filePath For Binary As #fileNumber
    fileLength = LOF(fileNumber)
    ReDim fileData(0 To fileLength - 1) ' 调整为0索引数组适配HTTP发送
    Get #fileNumber, , fileData
    Close #fileNumber
    
    ReadBinaryFile = fileData
End Function

关键修复点说明 #

1. 原代码核心错误：直接POST到文件URL不符合SharePoint API规范，且StrConv(fileData, vbUnicode)会破坏二进制文件结构，导致上传文件无效。
2. 解决方案1优势：利用Office原生支持，自动处理认证、文件锁定等问题，无需编写复杂的HTTP请求逻辑。
3. 解决方案2注意：若为M365现代认证环境，如需非交互式认证，可结合ADAL/MSAL库获取OAuth2令牌；SetAutoLogonPolicy依赖当前用户已登录SharePoint的凭据。

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