Stick with HTML format as that is widely supported. There are issues with creating Outlook objects from other Office applications and kindly fellow
Microsoft MVP Ben Clothier has produced an excellent function that determines if Outlook is available and opens it properly. If you don't use that function, then be prepared to manually start Outlook and Get that running application instead of creating a new one. I have assumed that Outlook is present, so have not included error trapping against that omission.
HTML format and Word formats are different from one another, but you should be able to get images from the document body into the message body using the following code to create the message. Here the source is the activedocument open in Word. If you are using some other document then open it and set it as the oSource document.
Code:
Option Explicit
'Ben Clothier - http://www.rondebruin.nl/win/s1/outlook/openclose.htm
#Const LateBind = True
Const olMinimized As Long = 1
Const olMaximized As Long = 2
Const olFolderCalendar As Long = 9
Const olFolderContacts As Long = 10
Const olFolderDrafts As Long = 16
Const olFolderInbox As Long = 6
Const olFolderOutbox = 4
Const olFolderSentMail = 5
Const olFolderTasks = 13
#If LateBind Then
Public Function OutlookApp( _
Optional WindowState As Long = olMinimized, _
Optional Folder As Long = olFolderInbox, _
Optional ReleaseIt As Boolean = False _
) As Object
Static o As Object
#Else
Public Function OutlookApp( _
Optional WindowState As Outlook.OlWindowState = olMinimized, _
Optional Folder As Long = olFolderInbox, _
Optional ReleaseIt As Boolean _
) As Outlook.Application
Static o As Outlook.Application
#End If
On Error GoTo ErrHandler
Select Case True
Case o Is Nothing, Len(o.Name) = 0
Set o = GetObject(, "Outlook.Application")
If o.Explorers.Count = 0 Then
InitOutlook:
'Open inbox to prevent errors with security prompts
o.Session.GetDefaultFolder(Folder).Display
o.ActiveExplorer.WindowState = WindowState
End If
Case ReleaseIt
Set o = Nothing
End Select
Set OutlookApp = o
ExitProc:
Exit Function
ErrHandler:
Select Case Err.Number
Case -2147352567
'User cancelled setup, silently exit
Set o = Nothing
Case 429, 462
Set o = GetOutlookApp()
If o Is Nothing Then
Err.Raise 429, "OutlookApp", "Outlook Application does not appear to be installed."
Else
Resume InitOutlook
End If
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error"
End Select
Resume ExitProc
Resume
End Function
#If LateBind Then
Private Function GetOutlookApp() As Object
#Else
Private Function GetOutlookApp() As Outlook.Application
#End If
On Error GoTo ErrHandler
Set GetOutlookApp = CreateObject("Outlook.Application")
ExitProc:
Exit Function
ErrHandler:
Select Case Err.Number
Case Else
'Do not raise any errors
Set GetOutlookApp = Nothing
End Select
Resume ExitProc
Resume
End Function
Sub CreateMessage()
Dim OutApp As Object
Dim olInsp As Object
Dim outMail As Object
Dim wdDoc As Document
Dim oSource As Document
Dim oRng As Range
Set oSource = ActiveDocument 'the document with the message format
oSource.Range.Copy
Set OutApp = OutlookApp()
Set outMail = OutApp.createitem(0)
With outMail
.to = "mlw@sierrawireless.com"
.Subject = "Test Email"
.BodyFormat = 2
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
oRng.PasteAndFormat (wdFormatOriginalFormatting)
.Display
End With
lbl_Exit:
Set OutApp = Nothing
Set olInsp = Nothing
Set oSource = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub