在从电子邮件创建任务时保留 html 格式

Question

我有一个小脚本，可以在 Outlook 中将电子邮件转换为任务。

我的主要挫折是它不会保留 html 格式，并将嵌入的图像作为附件处理。我想知道是否有人可以提供帮助。我知道这是可能的，因为我已手动将电子邮件正文直接复制到任务正文中，并且保存完好。

Sub ConvertSelectedMailtoTask()
    Dim objApp As Outlook.Application
    Dim objTask As Outlook.TaskItem
    Dim objMail As Outlook.MailItem

    Set objTask = Application.CreateItem(olTaskItem)
    Set objApp = Application

    If TypeName(objApp.ActiveWindow) = "Explorer" Then
        For Each objMail In Application.ActiveExplorer.Selection
            If Left(objMail.Subject, 3) = "RE:" Or Left(objMail.Subject, 3) = "FW:" Then
                subj = Right(objMail.Subject, Len(objMail.Subject) - 4)
            Else
                subj = objMail.Subject
            End If
            With objTask
                .Subject = subj
                .Importance = objMail.Importance
                .StartDate = objMail.ReceivedTime
                .Body = objMail.Body
                .DueDate = Date + 3
                If objMail.Attachments.Count > 0 Then
                    CopyAttachments objMail, objTask
                End If
                .ReminderSet = True
                .ReminderTime = Date + 2.5
                .Sensitivity = olPrivate
                .Save
            End With
        Next
    ElseIf TypeName(objApp.ActiveWindow) = "Inspector" Then
        Set objMail = objApp.ActiveInspector.CurrentItem

        If Left(objMail.Subject, 3) = "RE:" Or Left(objMail.Subject, 3) = "FW:" Then
                subj = Right(objMail.Subject, Len(objMail.Subject) - 4)
            Else
                subj = objMail.Subject
            End If
            With objTask
                .Subject = subj
                .Importance = objMail.Importance
                .StartDate = objMail.ReceivedTime
                .Body = objMail.Body
                .DueDate = Date + 3
                If objMail.Attachments.Count > 0 Then
                    CopyAttachments objMail, objTask
                End If
                .ReminderSet = True
                .ReminderTime = Date + 2.5
                .Sensitivity = olPrivate
                .Save
            End With
    End If
    Set objTask = Nothing
    Set objMail = Nothing
    Set objApp = Nothing
End Sub

这是附件的脚本

Sub CopyAttachments(objSourceItem, objTargetItem)
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
   strPath = fldTemp.Path & "\"
   For Each objAtt In objSourceItem.Attachments
      strFile = strPath & objAtt.FileName
      objAtt.SaveAsFile strFile
      objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
      fso.DeleteFile strFile
   Next

   Set fldTemp = Nothing
   Set fso = Nothing
End Sub

更新：

我发现了一段使用word文档来保留格式的代码：

Sub CopyFullBody(sourceItem As Object, targetItem As Object)
    Dim objDoc As Word.Document
    Dim objSel As Word.Selection
    Dim objDoc2 As Word.Document
    Dim objSel2 As Word.Selection
    On Error Resume Next
    ' get a Word.Selection from the source item
    Set objDoc = sourceItem.GetInspector.WordEditor
    If Not objDoc Is Nothing Then
        Set objSel = objDoc.Windows(1).Selection
        objSel.WholeStory
        objSel.Copy
        Set objDoc2 = targetItem.GetInspector.WordEditor
        If Not objDoc2 Is Nothing Then
            Set objSel2 = objDoc2.Windows(1).Selection
            objSel2.PasteAndFormat wdPasteDefault
        Else
            MsgBox "Could not get Word.Document for " & _
                   targetItem.Subject
        End If
    Else
        MsgBox "Could not get Word.Document for " & _
               sourceItem.Subject
    End If
    Set objDoc = Nothing
    Set objSel = Nothing
    Set objDoc2 = Nothing
    Set objSel2 = Nothing
End Sub

这似乎不是唯一的解决方案，因此更新我自己的帖子而不是回答我的问题，因为这似乎有点冗长（使用另一个应用程序只是为了给我格式化，当我可以手动复制和粘贴文本时在 Outlook 中一切都很好）。如果有人对此/定义附件类型有任何其他想法，请继续回答！

Answer 1

在行中

.Body = objMail.Body

您只要求非格式化的正文。试试吧：

.Body = objMail.htmlBody

还有一些完全不同的东西：我只是将提醒放在电子邮件本身上，所以我根本不需要创建额外的任务......

Answer 2

请记住，Outlook 任务、约会和任务使用 RTF，而不是 HTML。因此TaskItem、ContactItem 和AppointmentItem 对象只公开RtfBody 属性，但不公开HTMLBody（就像MailItem 一样）。

您需要将 HTML 转换为 RTF（您可以尝试使用 Word 对象模型）或使用 Redemption（我是它的作者）：与 Outlook 对象模型不同，它公开了 RDOTaskItem.HTMLBody属性并在设置该属性时将 HTML 动态转换为本机（用于任务）RTF。