It is a bit fiddly, but doable. I don't know if you can do it directly from
word, but you can certainly do it if you save the word file as RTF.
Firstly, you need Outlook Redemption (
http://www.dimastr.com/redemption) as
this will give you access to the RTF property of an email.
Below is a code sample (hastily hacked out of a project) I used for getting
RTF text into an Outlook appointment. Changing it for an email should be
fairly straightforward
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objDummy As Outlook.MailItem
Dim objRecip As Outlook.Recipient
Dim objAppt As Outlook.AppointmentItem
Dim objAppt2 As Outlook.AppointmentItem
Dim strMsg As String
Dim fso, f
Dim objContact As Object
Dim objContact2 As Object
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("C:\RTF_Temp.rtf", ForReading, True)
' ### name of person whose Calendar you want to use ###
Set objContact = CreateItem("Redemption.SafeMeetingItem")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objDummy = objApp.CreateItem(olMailItem)
Set objRecip = objDummy.Recipients.Add(strCalendarName)
objRecip.Resolve
If objRecip.Resolved Then
On Error Resume Next
Set objFolder = _
objNS.GetSharedDefaultFolder(objRecip, _
olFolderCalendar)
If Not objFolder Is Nothing Then
Set objAppt = objFolder.Items.Add
If Not objAppt Is Nothing Then
Set objContact = New Redemption.SafeAppointmentItem
objContact.Item = objAppt
With objContact
.Subject = "Subject"
.Start = #1/1/2006#
.End = #1/1/2006#
.AllDayEvent = True
.rtfbody = f.ReadAll
.Save
End With
End If
End If
Else
MsgBox "Could not find " & Chr(34) & strCalendarName & Chr(34), , _
"User not found"
End If
Simon
