Outlook VSTO插件：邮件HTML内容无法完整复制到约会项求助

问题根源 #

原代码依赖Word对象模型的Range.Copy()实现内容复制，但由于Outlook Inspector加载延迟、Range范围未正确识别完整邮件内容，或剪贴板被其他操作干扰，导致复制内容中途截断。

可靠解决方案 #

方案1：直接操作HTMLBody属性（推荐） #

绕过剪贴板和Word对象模型，直接将邮件的HTMLBody赋值给约会项，这是最稳定的方法，因为Exchange/Office 365环境下HTMLBody属性支持完整的HTML结构（包括表格）。

Sub CopyHtmlBodyfromMailToAppointment(CurrentMail As MailItem, CurrentAppointment As AppointmentItem)
    ' 直接完整复制邮件HTML内容到约会项
    CurrentAppointment.HTMLBody = CurrentMail.HTMLBody
    
    ' 若需保留约会项原有内容，可拼接HTML
    ' CurrentAppointment.HTMLBody = CurrentAppointment.HTMLBody & CurrentMail.HTMLBody
    
    CurrentAppointment.Save()
    ' 可选：如需立即显示约会项
    ' CurrentAppointment.Display()
End Sub

方案2：优化Word对象模型的复制逻辑 #

如果必须依赖Word对象模型，需确保Inspector完全加载，并明确获取文档的完整范围：

Sub CopyHtmlBodyfromMailToAppointment(CurrentMail As MailItem, CurrentAppointment As AppointmentItem)
    CurrentAppointment.Display()
    CurrentMail.BodyFormat = OlBodyFormat.olFormatHTML
    CurrentAppointment.BodyFormat = OlBodyFormat.olFormatHTML

    ' 等待邮件Inspector完全加载完成
    Dim mailInspector As Inspector = CurrentMail.GetInspector
    Do While mailInspector.ReadyState <> OlInspectorReadyState.olReadyStateComplete
        System.Threading.Thread.Sleep(100)
        System.Windows.Forms.Application.DoEvents()
    Loop

    ' 获取邮件文档的完整内容范围
    Dim objWordDocumentMail As Microsoft.Office.Interop.Word.Document = mailInspector.WordEditor
    Dim fullMailRange As Microsoft.Office.Interop.Word.Range = objWordDocumentMail.Range( _
        Start:=objWordDocumentMail.Content.Start, _
        End:=objWordDocumentMail.Content.End _
    )
    
    ' 清空剪贴板并复制完整范围
    System.Windows.Forms.Clipboard.Clear()
    fullMailRange.Copy()
    
    ' 等待剪贴板就绪
    Do While Not System.Windows.Forms.Clipboard.ContainsText(System.Windows.Forms.TextDataFormat.Html)
        System.Threading.Thread.Sleep(50)
        System.Windows.Forms.Application.DoEvents()
    Loop

    ' 等待约会项Inspector完全加载
    Dim apptInspector As Inspector = CurrentAppointment.GetInspector
    Do While apptInspector.ReadyState <> OlInspectorReadyState.olReadyStateComplete
        System.Threading.Thread.Sleep(100)
        System.Windows.Forms.Application.DoEvents()
    Loop

    ' 粘贴到约会项
    Dim objWordDocumentAppointment As Microsoft.Office.Interop.Word.Document = apptInspector.WordEditor
    objWordDocumentAppointment.Range(objWordDocumentAppointment.Content.End - 1).PasteSpecial( _
        DataType:=Microsoft.Office.Interop.Word.WdPasteDataType.wdPasteHTML _
    )
End Sub

方案对比 #

• 方案1无需依赖额外组件，执行效率高，完全避免剪贴板和Word对象的不稳定因素，优先推荐。
• 方案2适用于必须使用Word对象模型处理内容的场景，但需处理加载等待逻辑，相对复杂。

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