VBA上传文件至SharePoint文档库在站点迁云后失效问题问询

• 原有代码存在逻辑缺失：仅调用了LobjXML.Open方法初始化请求，没有执行LobjXML.Send提交二进制文件内容，请求未实际发出，因此无报错也无上传动作
• 本地部署的SharePoint默认支持Windows集成身份认证，迁移到SharePoint Online云端后，旧的Microsoft.XMLHTTP组件不支持现代OAuth认证，无法正常传递云端身份凭证
• 多数SharePoint Online租户默认禁用未认证的PUT请求，即使URL配置正确也会被系统拦截

方案1：映射SharePoint为网络驱动器+简化VBA逻辑 #

操作成本最低，适合个人或小范围使用场景：

1. 先将目标SharePoint文档库映射为本地网络驱动器：打开Windows资源管理器 → 右键「此电脑」→ 选择「映射网络驱动器」→ 填写SharePoint文档库的完整URL（需去掉末尾的/Forms/AllItems.aspx后缀）→ 勾选「登录时重新连接」，按提示完成Office 365账号验证
2. 替换原有VBA逻辑为直接文件拷贝，代码示例如下：

Dim objFSO As Scripting.FileSystemObject
Set objFSO = New Scripting.FileSystemObject

' 本地源文件完整路径
sSourceFile = CurrentProject.Path & "\Published\" & ELookup("FrontEndFileNameAccdb", "tbl_Lookup")
' 映射后的SharePoint驱动器路径，示例为映射到Z盘根目录，可按需调整
sTargetFile = "Z:\" & ELookup("FrontEndFileNameAccdb", "tbl_Lookup")

' 第三个参数为True表示覆盖已存在的同名文件
objFSO.CopyFile sSourceFile, sTargetFile, True

Set objFSO = Nothing

方案2：调整原有HTTP请求逻辑适配云端认证 #

无需依赖网络驱动器映射，适合批量自动化上传场景：
将原有Microsoft.XMLHTTP替换为支持现代认证的MSXML2.XMLHTTP.6.0组件，补充请求发送和状态校验逻辑，代码示例如下：

Dim binaryByte() As Byte
Dim lngFileLength As Long
Dim LobjXML As Object
Dim sSourceFile, sDestinationURL As String

' 读取本地文件为二进制流
sSourceFile = CurrentProject.Path & "\Published\" & ELookup("FrontEndFileNameAccdb", "tbl_Lookup")
lngFileLength = FileLen(sSourceFile) - 1
ReDim binaryByte(lngFileLength)
Open sSourceFile For Binary As #1
Get #1, , binaryByte
Close #1

' 初始化HTTP组件
Set LobjXML = CreateObject("MSXML2.XMLHTTP.6.0")
sDestinationURL = ELookup("SharePointFolderURLPath", "tbl_Lookup") & ELookup("FrontEndFileNameAccdb", "tbl_Lookup")

' 配置并发送请求
LobjXML.Open "PUT", sDestinationURL, False
' 运行代码的设备已登录对应租户Office 365账号时，组件会自动传递身份凭证，无需额外配置Authorization头
LobjXML.Send binaryByte

' 可选：添加上传结果校验
If LobjXML.Status = 200 Or LobjXML.Status = 201 Then
    Debug.Print "文件上传成功"
Else
    Debug.Print "上传失败，错误码：" & LobjXML.Status & "，错误信息：" & LobjXML.responseText
End If

Set LobjXML = Nothing

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