SharePoint生成的Word文件经Outlook发送后损坏问题咨询

我用Excel宏将Excel表格字段填充至Word模板，保存到SharePoint后可正常打开、下载及编辑。但使用另一个Excel宏从SharePoint调取该文件作为Outlook附件发送时，附件损坏，过程无报错。

填充并保存Word文档的宏代码 #

Sub inpWord()
    Dim bStarted As Boolean, wdApp As Word.Application, wdDoc As Word.Document, wdTemp As String
    
    wdTemp = "XXXXXX SHAREPOINT LINK XXXXXXX"
    Set inpBook = xlApp.Workbooks("Input Tool")
    
    On Error Resume Next 
        'Open word 
       
    Set wdDoc = Documents.Add(Template:=wdTemp, NewTemplate:=False, DocumentType:=wdNewBlankDocument, Visible:=True)
    Filename = "SHAREPOINT FOLDER LINK" & CStr(RefNum) & ".docx?web=1"
    
    With wdDoc
        Set CCDate = .SelectContentControlsByTitle(1)
        'For loop to populate word template
        .SaveAs Filename
    End With

End Sub

调取文件并发送邮件的宏代码 #

Private Sub CommandButton1_Click()
Dim bStarted As Boolean, oOutlookApp As Outlook.Application, oItem As Outlook.MailItem, xlApp As Object, xlBook As Object

Set xlApp = GetObject(, "Excel.Application")
Set xlBook = xlApp.Workbooks("Purchasing Tracker")

POAttach = "SHAREPOINT LINK" & CStr(PONum) & ".docx?web=1"

On Error Resume Next 'Open Outlook unless already open
    Set oOutlookApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set oOutlookApp = CreateObject("Outlook.Application")
        bStarted = True
        Err.Clear
    End If
    oOutlookApp.Visible = True

Set oItem = oOutlookApp.CreateItem(olMailItem)

    With oItem
        .To = "RECIEVER"
        .Subject = "XX"
        .HTMLBody = "XX"
        .Attachments.Add Source:=POAttach, Type:=1, _
        DisplayName:="Formula Student Purchase Order: " & CStr(UserForm1.TextBox1.Value)
        .Send
    End With
End Sub

解决办法 #

核心原因 #

Outlook的Attachments.Add方法直接使用带?web=1的SharePoint链接时，实际获取的是网页预览而非真实文档文件，导致附件损坏。

具体修复步骤 #

1. 修正文档保存路径
   在inpWord宏中，保存Word文档时使用SharePoint的UNC路径或本地映射驱动器路径，不要带?web=1后缀：

   ' 示例：使用UNC路径
   Filename = "\\your-sharepoint-site\sites\your-library\target-folder\" & CStr(RefNum) & ".docx"
   ' 或映射驱动器后的路径（如Z盘映射了SharePoint库）
   Filename = "Z:\target-folder\" & CStr(RefNum) & ".docx"
   

2. 修改附件获取逻辑
   发邮件的宏中，同样使用上述真实文件路径。如果必须依赖SharePoint在线链接，先将文件下载到本地临时目录再添加附件：

   Dim tempPath As String, wdApp As Object, wdDoc As Object
   tempPath = Environ("TEMP") & "\" & CStr(PONum) & ".docx"
   
   ' 从SharePoint打开并保存到本地临时目录
   Set wdApp = CreateObject("Word.Application")
   Set wdDoc = wdApp.Documents.Open("SHAREPOINT LINK" & CStr(PONum) & ".docx") ' 去掉?web=1
   wdDoc.SaveAs2 tempPath
   wdDoc.Close
   wdApp.Quit
   
   ' 添加本地临时文件作为附件
   .Attachments.Add Source:=tempPath, Type:=1, DisplayName:="Formula Student Purchase Order: " & CStr(UserForm1.TextBox1.Value)
   
   ' 发送后清理临时文件
   Kill tempPath
   

3. 优化代码健壮性

   • 移除不必要的On Error Resume Next，或在关键代码块后添加错误捕获逻辑，避免掩盖真实问题；
   • 显式声明所有变量，比如inpWord宏中补充Dim xlApp As Excel.Application, inpBook As Excel.Workbook，避免隐式变量导致的潜在错误。

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