Outlook Appointment isn't showing Attendees that have been added

Question

I'm having some problems with some pieces of code that I've Frankenstein'd from the web. I have a Word document that uses a command button to run a piece of code, the end result being an Outlook Appointment being generated with a template added, as well as recipients. I've used 2 different methods, and they each present their own problem.

Method 1: Generates the Appointment, includes and displays the attendees, but does not allow for HTML formatting of the body

---

Dim xOutlookObj As Object
Dim OMail As Object
Dim xMeeting As Object
Dim xDoc As Object
Dim myRequiredAttendee As Outlook.Recipient
Dim myOptionalAttendee As Outlook.Recipient
Application.ScreenUpdating = False

Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmail = xOutlookObj.CreateItem(olMailItem)
Set xDoc = ActiveDocument
opCancel = False

Set xOutlookObj = CreateObject("Outlook.Application")
Set xMeeting = xOutlookObj.CreateItem(olAppointmentItem)
Set myRequiredAttendee = xMeeting.Recipients.Add(EMAIL ADDRESSES)
myRequiredAttendee.Type = olRequired
Set xDoc = ActiveDocument

With xMeeting
    .MeetingStatus = olMeeting
    .Display
    .Subject = "MEETING SUBJECT"
    .Duration = 60
    .Body = "MESSAGE BODY THAT I'D LIKE TO FORMAT, BUT THIS METHOD DOESN'T PERMIT HTML"

End With

Set xDoc = Nothing
Set xMeeting = Nothing
Set xOutlookObj = Nothing
Application.ScreenUpdating = True

Method 2: Generates the Appointment, allows for HTML formatting of the body, loads the attendees but does not display them. When I click the 'Invite Attendee' button in the invite, they all appear (so they're obviously being loaded).

Dim olapp As Outlook.Application, appt As Outlook.AppointmentItem
Dim m As Outlook.MailItem
Dim rtf() As Byte

Set olapp = New Outlook.Application
Set m = olapp.CreateItem(olMailItem)
Set appt = olapp.CreateItem(olAppointmentItem)

appt.Display
appt.Subject = "MEETING SUBJECT"
appt.Duration = 60
appt.RequiredAttendees = "EMAIL ADDRESSES"

m.BodyFormat = olFormatHTML
m.HTMLBody = "<font style=""color: red;"">VERIFY SUBJECT LINE & MEETING START TIME ARE CORRECT, THEN DELETE THIS LINE" & _
        "<font style=""color: black;""><p>REST OF TEXT BODY</P>
m.GetInspector().WordEditor.Range.FormattedText.Copy
appt.GetInspector().WordEditor.Range.FormattedText.Paste
m.Close False 'don't save...

What I'm looking for is code that creates the Appointment, loads and displays the attendees, and allows HTML formatting of the body. Also, I can't use the .send command because the body of the invite still needs to be edited before it's sent - which is why I'd like the attendees to be displayed to avoid confusion.

Thanks!

Answer 1

#1 is fine, but AppointmentItem object does not directly support HTML - you get either plain text Body property or RTF formatted (array of byte) RtfBody property. You needed to either generate the appropriate RTF, or use AppointmentItem.GetInspector().WordEditor (returns Word's Document object) to produce the suitably formatted body.

Answer 2

The following code generates the appointment, loads the recipients and displays them, as well as formats the message body in HTML.

Dim xOutlookObj As Object
Dim OMail As Object
Dim xMeeting As Object
Dim xDoc As Object
Dim myRequiredAttendee As Outlook.Recipient
Dim myOptionalAttendee As Outlook.Recipient
Application.ScreenUpdating = False

Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmail = xOutlookObj.CreateItem(olMailItem)
Set xDoc = ActiveDocument

Set xOutlookObj = CreateObject("Outlook.Application")
Set xMeeting = xOutlookObj.CreateItem(olAppointmentItem)
Set myRequiredAttendee = xMeeting.Recipients.Add(EMAIL LIST)
myRequiredAttendee.Type = olRequired
Set xDoc = ActiveDocument

With xMeeting
    .MeetingStatus = olMeeting
    .Display
    .Subject = "MEETING SUBJECT"
    .Duration = 60
    
    '**
    xEmail.BodyFormat = olFormatHTML
    xEmail.HTMLBody = "<font style=""color: red;"">VERIFY SUBJECT LINE & MEETING START TIME ARE CORRECT, THEN DELETE THIS LINE" & _
      "<font style=""color: black;""><p>THE REST OF APPT MESSAGE</p>"
    xEmail.GetInspector().WordEditor.Range.FormattedText.Copy
    xMeeting.GetInspector().WordEditor.Range.FormattedText.Paste
    '**

End With

Set xDoc = Nothing
Set xMeeting = Nothing
Set xOutlookObj = Nothing
Application.ScreenUpdating = True

The ** part is what I changed to make this work.