How to insert MS Word formatted content into Outlook mail?

Question

The Problem

This code sends mail with MS Word.

The mail body is same as the Word content but the mail body is unformatted.

How is it possible to insert the formatted Word document content into the mail body?

Sub SendDocumentInMail()

Dim bStarted As Boolean
Dim oOutlookApp As Object
Dim oItem As Object

On Error Resume Next

'Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
    'Outlook wasn't running, start it from code
    Set oOutlookApp = CreateObject("Outlook.Application")
    bStarted = True
End If

'Create a new mailitem
Set oItem = oOutlookApp.CreateItem(olMailItem)

With oItem
    'Set the recipient for the new email
   .To = "[email protected]"
    'Set the recipient for a copy
    .CC = "[email protected]"
    'Set the subject
    .Subject = "New subject"
    'The content of the document is used as the body for the email
    .Body = ActiveDocument.Content
    .Send
End With

If bStarted Then
    'If we started Outlook from code, then close it
    oOutlookApp.Quit
End If

'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing

End Sub

Maybe the body is set to plain text? MailItem.BodyFormat Property — Dávid Laczkó
The mail is in HTML format already but it lost formatting when come from Word to Outlook mail. — dotvihar
Possible duplicate of this, the accepted answer lists possibilites. — Dávid Laczkó
You may make an answer post and accept as well. stackoverflow.com/help/self-answer — niton
@niton Thank you for calling my attention. When I asked, I did not know the answer yet. Later I found the solution based on the information received. — dotvihar

dotvihar dotvihar · Accepted Answer · 2018-11-20T06:47:19

The solution

(Edited on 2018.11.19)

After some hours I found the solution:

Sub SendMail()

Selection.WholeStory
Selection.Copy

Dim olapp As Object
Dim olemail As Object
Dim olInsp As Object
Dim wddoc As Object

    On Error Resume Next
    Set olapp = GetObject(, "Outlook.Application")
    If Err <> 0 Then Set olapp = CreateObject("Outlook.Application")
    On Error GoTo 0
    Set olemail = olapp.CreateItem(0)
    With olemail
        .BodyFormat = 3
        .To = "[email protected]"
        .Subject = "Test mail"
        Set olInsp = .GetInspector
        Set wddoc = olInsp.wordeditor
        wddoc.Content.Paste
        .Display
    End With
 End Sub

How to insert MS Word formatted content into Outlook mail?

The Problem

1 Answers

The solution