Copy formatted Email body into new Word document via VBA and keep the text formatting

Question

I need to copy the email body into a new Word document and keep the text formatted. As far as I've managed I can copy the text from an email body into an open Word application. But I lose the formatting. When I copy the HTMLBody I see the HTML-tags...

Secondary question in this is: How can I start the Word application from Outlook and see it on my screen.

Thanks in advance for helping me out!

This is the formatted email in Outlook

And this is the result I expect it to have in Word.

The Code below

Sub CopyToWord()
Dim wdApp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim bStarted As Boolean
Dim olItem As mailItem
If Application.ActiveExplorer.Selection.Count = 0 Then
    MsgBox "No Items selected!", vbCritical, "Error"
    Exit Sub
End If
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err Then
    Set wdApp = CreateObject("Word.Application")
    bStarted = True
End If
On Error GoTo 0
    

'EDIT for Seqondary question:
'Make Word application visible for the user
wdApp.Visible = True

For Each olItem In Application.ActiveExplorer.Selection
    Set wdDoc = wdApp.Documents.Add
    'wdDoc.Range.Text = olItem.HTMLBody
    'wdDoc.Range.Text = olItem.Body
    wdDoc.Range.Text = olItem.Body
    
Next olItem
Set wdDoc = Nothing
Set wdApp = Nothing
Set olItem = Nothing
End Sub

Super Symmetry Super Symmetry · Accepted Answer · 2020-07-20T09:59:41

Each MailItem has a word document associated with it. You simply have to get hold of this document, copy its range and paste it into your wdDoc

Try this

Sub CopyToWord()
Dim wdApp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim bStarted As Boolean
Dim olItem As MailItem
Dim wdItemWordEditor As Object '* A word document
If Application.ActiveExplorer.Selection.Count = 0 Then
    MsgBox "No Items selected!", vbCritical, "Error"
    Exit Sub
End If
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err Then
    Set wdApp = CreateObject("Word.Application")
    bStarted = True
End If
On Error GoTo 0

'EDIT for Secondary question:
'Make Word application visible for the user
wdApp.Visible = True

For Each olItem In Application.ActiveExplorer.Selection
    Set wdDoc = wdApp.Documents.Add
    Set wdItemWordEditor = olItem.GetInspector.WordEditor
    wdItemWordEditor.Range.Copy
    wdDoc.Range.Paste
    'wdDoc.Range.Text = olItem.HTMLBody
    'wdDoc.Range.Text = olItem.Body
    'wdDoc.Range.Text = olItem.Body
    
Next olItem
Set wdDoc = Nothing
Set wdApp = Nothing
Set olItem = Nothing
End Sub

Copy formatted Email body into new Word document via VBA and keep the text formatting

1 Answers