CODEWITHSUNDEEP
excelvbaoutlook
Pablo
Pablo

Reputation: 21

How to include formatted text in the body of an Outlook invite from Excel

I would like to insert text with format (links, bold, highlighted...) in an Outlook invite using Excel VBA.

I have a program that send invites from Excel. The body contains plain text. I am using .body but I am afraid I will have to use a different approach (.HTMLBody doesn't work for invites and RTFbody seems to be over complicated from what I have read).

I have body templates in Word, in Outlook as quick parts, in the clipboard and some other places.

Code:

Sub Invite_Merge(meeting_date As Date, meeting_time As Double,         
    meeting_duration As Integer, client_email As String, meeting_subject As String,
    meeting_location As String, client_name As String, meeting_body As String,
    meeting_sender As String)


Dim O As Outlook.Application
Set O = New Outlook.Application

Dim OAPT As Outlook.AppointmentItem
Set OAPT = O.CreateItem(olAppointmentItem)
OAPT.MeetingStatus = olMeeting

Dim meeting_start
meeting_start = DateValue(meeting_date) + meeting_time

With OAPT

    .Recipients.Add (client_email)
    .Subject = meeting_subject
    .Start = meeting_start
    .Duration = meeting_duration
    .Location = meeting_location
    '.body = here is where I have trouble, the property body only allows me to insert plaintext, .HTMLBody is not a AppointmentsItem property and I have not found an example code on how to use convert a formatted text (with links, bold, different fonts...) into a compatible .RTFBody byte array
    .Display
    '.Send

End With

End Sub


Sub Send_Invites()

row_number = 2

Do
DoEvents

row_number = row_number + 1
If IsEmpty(Sheet1.Range("D" & row_number)) = False Then

    Call Invite_Merge(Sheet1.Range("A" & row_number), Sheet1.Range("B" & row_number), Sheet1.Range("C" & row_number), Sheet1.Range("D" & row_number), Sheet1.Range("E" & row_number), Sheet1.Range("F" & row_number), Sheet1.Range("G" & row_number), Sheet1.Range("H" & row_number), Sheet1.Range("A" & "1"))

End If
Loop Until row_number = 100

End Sub

Upvotes: 0

Views: 5640

Answers (1)

Tim Williams
Tim Williams

Reputation: 166391

Try this:

Sub SetApptWithHTMLContent()

    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.Subject = "Meeting request"
    '...set other appointment properties
    appt.Display
    'put the HTML into the mail item, then copy and paste to appt
    m.BodyFormat = olFormatHTML
    m.HTMLBody = Range("A1").Value 'sample HTML stored in a cell
    m.GetInspector().WordEditor.Range.FormattedText.Copy
    appt.GetInspector().WordEditor.Range.FormattedText.Paste
    m.Close False 'don't save...

End Sub

Sample HTML:

  <h1>Title Here</H1>
	<span style='background-color: #ffff00'>Table of stuff:</span><br>
	<table>
	<tr>
		<td style='background-color: #ff9900'>One</td>
		<td>Two</td>
	</tr>
	<tr>
		<td>Three</td>
		<td>Four</td>
	</tr>
	</table>

Final appointment body:

enter image description here

Upvotes: 5

Related Questions