Public Sub ApptFromMail(Item As MailItem) Dim objInsp As Inspector Dim objDoc As Word.Document Dim objSel As Word.Selection Dim objAppt As Outlook.AppointmentItem Set objAppt = Application.CreateItem(olAppointmentItem) Item.Display If Item.Class = olMail Then Set objInsp = Item.GetInspector If objInsp.EditorType = olEditorWord Then Set objDoc = objInsp.WordEditor Set objWord = objDoc.Application Set objSel = objWord.Selection With objSel .WholeStory .Copy End With Item.Close olDiscard End If End If Set objInsp = objAppt.GetInspector Set objDoc = objInsp.WordEditor Set objSel = objDoc.Windows(1).Selection With objAppt .Subject = Item.Subject .location = "Location" .AllDayEvent = True .BusyStatus = olBusy .Start = Date + 3 objSel.PasteAndFormat (wdFormatOriginalFormatting) .Display .Save End With Set objAppt = Nothing End Sub