See if it works any better if you just get the entire contents of the Word
doc as a string and set Body to that.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Namgaw" wrote in message
...
snip
The latter, i.e. copy text from Word to an Outlook
item body using code. I save the file to filtered HTML. Here is the
code:

Sub SendDocumentInMail()

Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim myDoc As Document
Dim fileName As String


'On Error Resume Next

ActiveDocument.Bookmarks("stock_code_V").Select
fileName = Selection.Range
fileName = getString(fileName)
ActiveDocument.SaveAs fileName:="H:\Diana\email macros\email tmp\" &
fileName, _
FileFormat:=wdFormatDocument, LockComments:=False,
Password:="", _
AddToRecentFiles:=True, WritePassword:="",
ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData _
:=False, SaveAsAOCELetter:=False

'wdformatfilteredhtml

'ActiveDocument.SaveAs fileName:="H:\Diana\email macros\email tmp\" &
fileName, _
FileFormat:=wdFormatRTF, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False,
_
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False,
SaveFormsData _
:=False, SaveAsAOCELetter:=False

Selection.WholeStory


'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)


ActiveDocument.Bookmarks("stock_code_V").Select
Dim fso As FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Dim ts As TextStream
Set ts = fso.OpenTextFile("H:\Diana\email macros\email tmp\" &
fileName & ".doc", _
ForReading)

strtext = ts.ReadAll


With oItem
'Set the recipient for the new email
.To = "
'Set the recipient for a copy
.CC = "
'Set the subject
.Subject = "FPKCCW: " & Selection.Range & " - Title"
'The content of the document is used as the body for the email
' Selection.WholeStory
' Selection.Copy
Selection.WholeStory
.Body = strtext
' .HTMLBody = strtext
' .HTMLBody = Selection.Range
.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
Private Function getString(ByVal Stringin As String) As String
If InStr(1, Stringin, "/") 0 Then
getString = Replace(Stringin, "/", "")
End If
End Function



What happens is that the mail comes in with everything but the tables,
graphics.