如何用Excel VBA通过URL打开SharePoint Word文档并复制内容到邮件？

核心问题原因 #

直接传入SharePoint的HTTPS URL给wd.Documents.Open()无法生效，因为Word的Documents.Open方法默认仅支持本地文件路径或SharePoint的UNC格式路径（而非HTTP/HTTPS URL）。

可行解决方案 #

以下两种方案任选其一即可：

方案1：使用SharePoint的UNC映射路径 #

将SharePoint文档的HTTPS URL转换为UNC格式，格式规则为：
\\<租户名>.sharepoint.com@SSL\DavWWWRoot\sites\<站点名>\<文档库名>\<文档相对路径>
例如原URL为https://contoso.sharepoint.com/sites/TeamSite/Documents/Report.docx，对应的UNC路径是\\contoso.sharepoint.com@SSL\DavWWWRoot\sites\TeamSite\Documents\Report.docx

方案2：先将在线文档下载到本地临时文件夹 #

通过VBA把SharePoint上的Word文档下载到本地临时目录，再打开本地文件处理，完成后删除临时文件。

修正后的代码示例（方案1：UNC路径） #

Dim OutlookApp As Object
Dim wd As Object, editor As Object
Dim doc As Object
Dim oMail As MailItem
Dim docPath As String

' 初始化Word和Outlook对象
Set wd = CreateObject("Word.Application")
Set OutlookApp = CreateObject("Outlook.Application")
Set oMail = OutlookApp.CreateItem(0) ' 创建新邮件

' 替换为你的SharePoint文档UNC路径
docPath = "\\contoso.sharepoint.com@SSL\DavWWWRoot\sites\TeamSite\Documents\Report.docx"

On Error Resume Next ' 捕获路径或权限错误
Set doc = wd.Documents.Open(docPath)
On Error GoTo 0

If Not doc Is Nothing Then
    doc.Content.Copy
    doc.Close False ' 不保存关闭文档
    wd.Quit ' 退出Word进程
    
    ' 将内容粘贴到邮件
    With oMail
        .BodyFormat = olFormatRichText
        Set editor = .GetInspector.WordEditor
        editor.Content.Paste
        .Display
    End With
Else
    MsgBox "无法打开SharePoint文档，请检查路径是否正确或权限是否足够"
    wd.Quit
End If

' 释放对象资源
Set doc = Nothing
Set wd = Nothing
Set editor = Nothing
Set oMail = Nothing
Set OutlookApp = Nothing

修正后的代码示例（方案2：临时文件下载） #

Dim OutlookApp As Object
Dim wd As Object, editor As Object
Dim doc As Object
Dim oMail As MailItem
Dim docURL As String, tempPath As String
Dim xHttp As Object

' 初始化对象
Set OutlookApp = CreateObject("Outlook.Application")
Set oMail = OutlookApp.CreateItem(0)
Set wd = CreateObject("Word.Application")
Set xHttp = CreateObject("MSXML2.XMLHTTP.6.0")

' 替换为你的SharePoint文档HTTPS URL
docURL = "https://contoso.sharepoint.com/sites/TeamSite/Documents/Report.docx"
' 生成本地临时文件路径
tempPath = Environ("TEMP") & "\TempWordDoc.docx"

' 下载在线文档到临时目录
xHttp.Open "GET", docURL, False
' 若站点需要身份验证，可添加授权头（示例需根据实际认证方式调整）
' xHttp.setRequestHeader "Authorization", "Bearer your_access_token"
xHttp.Send

If xHttp.Status = 200 Then
    ' 将下载内容写入临时文件
    Open tempPath For Binary As #1
    Put #1, , xHttp.responseBody
    Close #1
    
    ' 打开临时文档并复制内容
    Set doc = wd.Documents.Open(tempPath)
    doc.Content.Copy
    doc.Close False
    wd.Quit
    
    ' 粘贴内容到邮件
    With oMail
        .BodyFormat = olFormatRichText
        Set editor = .GetInspector.WordEditor
        editor.Content.Paste
        .Display
    End With
    
    ' 清理临时文件
    Kill tempPath
Else
    MsgBox "下载文档失败，错误码：" & xHttp.Status
    wd.Quit
End If

' 释放对象资源
Set xHttp = Nothing
Set doc = Nothing
Set wd = Nothing
Set editor = Nothing
Set oMail = Nothing
Set OutlookApp = Nothing

' 可选：身份验证用的令牌获取函数（需根据实际环境实现）
Function GetSharePointAccessToken() As String
    GetSharePointAccessToken = "your_valid_access_token"
End Function

注意事项 #

• 方案1需确保当前用户拥有SharePoint站点访问权限，且UNC路径格式完全正确
• 方案2若遇到身份验证问题，需补充对应平台的令牌获取逻辑；测试环境可使用MSXML2.ServerXMLHTTP并设置.SetOption 2, 13056忽略证书错误（生产环境不建议）
• 操作完成后务必退出Word进程，避免后台残留进程占用资源

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