基于VBA的SharePoint REST API文件上传功能适配咨询

问题背景 #

我已在Excel工作簿中使用VBA实现了SharePoint API的连接、授权与文件下载功能，相关代码如下：

base_url = "SP URL/_api/web/"
end_url = "GetFileByServerRelativeUrl('" & endpoint_url
url = base_url & end_url & filepath & "')/$value"
HttpRequest.Open "GET", url
HttpRequest.setRequestHeader "Authorization", "Bearer " & auth_token
HttpRequest.Send
sresult = HttpRequest.responseText
sObject = HttpRequest.responseBody
filepath = Replace(filepath, "%20", " ")
filestring = Replace(filestring, "%20", " ")
'MsgBox HttpRequest.Status
If HttpRequest.Status = 200 Then
    'MsgBox HttpRequest.responseBody
    Set MyStream = CreateObject("ADODB.Stream")
    MyStream.Open
    MyStream.Type = 1
    MyStream.Write HttpRequest.responseBody
    MyStream.SaveToFile filestring, 2
    MyStream.Close
Else
MsgBox HttpRequest.Status
MsgBox "Error - Connection to server failed"
End If

目前正尝试将该代码适配为文件上传场景，已查阅SharePoint API文档，了解到需要将URL端点调整为/GetFolderByServerRelativeUrl('/Library Name/Folder Name')/Files/add(url='example.txt',overwrite=true)，但不清楚如何适配HttpRequest部分——是否只需将HttpRequest.Open "GET", url修改为HttpRequest.Open "SEND", url并调整后续代码即可？曾尝试改写MyStream部分，但对上传请求的构造并不熟悉，不清楚需要做出哪些完整修改。

完整适配方案 #

不是用SEND方法，SharePoint文件上传需要用POST请求，同时要调整请求头、文件流读取逻辑，以下是完整的修改要点和代码：

关键修改点 #

• 请求方法替换为POST，而非SEND
• 添加Content-Type: application/octet-stream请求头，告知服务器上传的是二进制文件
• 读取本地文件的二进制流，作为请求的发送内容（而不是处理响应流）
• 正确构造上传API的端点URL，注意路径编码和参数格式

完整上传代码 #

Sub UploadToSharePoint()
    Dim HttpRequest As Object
    Dim MyStream As Object
    Dim base_url As String
    Dim upload_endpoint As String
    Dim url As String
    Dim auth_token As String
    Dim local_filepath As String ' 本地要上传的文件路径
    Dim sp_folder_path As String ' SharePoint目标文件夹的服务器相对路径，比如 "/Documents/TestFolder"
    Dim sp_filename As String ' 上传到SharePoint后的文件名，比如 "test_upload.txt"
    
    ' 配置参数
    base_url = "你的SharePoint站点URL/_api/web/"
    auth_token = "你的Bearer令牌"
    local_filepath = "C:\LocalFiles\test.txt"
    sp_folder_path = "/Documents/TestFolder"
    sp_filename = "test_upload.txt"
    
    ' 构造上传API端点
    ' 注意路径中的空格要转义为%20，或者用URLEncode处理
    sp_folder_path = Replace(sp_folder_path, " ", "%20")
    sp_filename = Replace(sp_filename, " ", "%20")
    upload_endpoint = "GetFolderByServerRelativeUrl('" & sp_folder_path & "')/Files/add(url='" & sp_filename & "',overwrite=true)"
    url = base_url & upload_endpoint
    
    ' 创建HTTP请求对象
    Set HttpRequest = CreateObject("MSXML2.XMLHTTP")
    HttpRequest.Open "POST", url, False
    
    ' 设置请求头
    HttpRequest.setRequestHeader "Authorization", "Bearer " & auth_token
    HttpRequest.setRequestHeader "Content-Type", "application/octet-stream"
    
    ' 读取本地文件的二进制流
    Set MyStream = CreateObject("ADODB.Stream")
    MyStream.Open
    MyStream.Type = 1 ' 二进制类型
    MyStream.LoadFromFile local_filepath
    
    ' 发送请求（将文件流作为请求体）
    HttpRequest.Send MyStream.Read
    
    ' 处理响应
    If HttpRequest.Status = 200 Or HttpRequest.Status = 201 Then
        MsgBox "文件上传成功！"
    Else
        MsgBox "上传失败，状态码：" & HttpRequest.Status & vbCrLf & "响应信息：" & HttpRequest.responseText
    End If
    
    ' 释放对象
    MyStream.Close
    Set MyStream = Nothing
    Set HttpRequest = Nothing
End Sub

注意事项 #

• 确保auth_token有效，且拥有目标文件夹的上传权限
• sp_folder_path是SharePoint的服务器相对路径，可从站点库的URL中获取
• 如果文件名或路径包含特殊字符，建议用URLEncode函数进行编码，避免路径解析错误
• 若使用异步请求（Open方法第三个参数设为True），需要添加回调函数处理响应

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