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。请尝试改为：

.Body = objMail.htmlBody

和完全不同的东西：我只是在电子邮件中添加提醒，所以我根本不需要创建额外的任务......

Answer 2

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

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

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

2 个答案: