Preserving html format in creating tasks from email - vba

Question

I have a little script that converts an email into a Task in my outlook.
My main frustration is that it won't preserve the html format, and deals with embedded images as attachments. I was wondering if anyone could help. I know it is possible as I've copied the body of an email directly across to the body of a task manually and it is preserved fine.
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
And here is the script for the attachments
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
Update:
I found a bit of code that uses a word document to preserve the formatting:
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
This doesn't seem like it would be the only solution hence updating my own post instead of answering my question as this seems a bit long winded (using another application just to give me formatting, when I can copy and paste text manually just fine all in Outlook). If anyone has any other thoughts on this/defining attachment types please carry on answering!

Answer 1

in the line
.Body = objMail.Body
you only ask fot the non-formatted Body. Try instead:
.Body = objMail.htmlBody
and something completely different: I just put reminders onto the emails themselves, so I have no need to create extra Tasks at all...

Answer 2

Keep in mind that Outlook tasks, appointments and tasks work with RTF, not HTML. hence TaskItem, ContactItem and AppointmentItem objects only expose the RtfBody property, but not HTMLBody (like MailItem does).
You will need to either convert HTML to RTF (you can try the Word Object Model for that) or use Redemption (I am its author): unlike Outlook Object Model, it exposes the RDOTaskItem.HTMLBody property and dynamically converts HTML to the native (for tasks) RTF when that property is set.