Sending Mail with Html Body
Hi,
I have created a function that allows me to send mail to an account, from
an account with the options of fileattachments, etc...
What I would now like to do is be able to send the body of the message in
HTML format so it looks "Cool!". I have included my function and I have
searched thru the help for HTMLBody, etc... but nothing seems to point me
in the right direction. Is it even possible to send mail with a HTML
body?
I would think it was possible because you can send mail from Outlook and
select Actions, New Message Using, HTML (No stationary)...then when you
receive the message, right click the bosy and click View Source (which is
in HTML format) Any ideas?
Thanks in advance for any and all help!
Geo...
(Function Below)
---------------------------------------------
Function OutlookMail(sTo As String, sSubject As String, sBody As String,
account_name As String, filename As String) As Long
Dim objSession As MAPI.Session
Dim objMessage As MAPI.Message 'As Message '
Dim objOneRecip As MAPI.Recipient 'As Recipient
Dim myAttachments As MAPI.Attachments
Const olByValue = 1
On Error GoTo Error_Handler
OutlookMail = EXCH_Success
Set objSession = CreateObject("MAPI.Session")
' create a session and log on -- username and password in profile
Set objSession = CreateObject("MAPI.Session")
' change the parameters to valid values for your configuration
objSession.Logon ProfileInfo:="SXEXCH2" & vbLf & account_name
' create a message and fill in its properties
Set objMessage = objSession.Outbox.Messages.Add
objMessage.Subject = sSubject 'Item.Subject
objMessage.HTMLBody
sBody = "<p><font color=" & Chr(34) & "#FF0000" & Chr(34) & "><b>This
is Text in RED and BOLD</b></font></p>"
sBody = sBody & "<p><u>Not Red, but underlined</u></p>"
sBody = sBody & "<p><font color=" & Chr(34) & "#0000FF" & Chr(34) &
"><b><i>Italics, bold and Blue</i></b></font></p>"
objMessage.Text = sBody 'Item.Body
Set objOneRecip = objMessage.Recipients.Add
objOneRecip.Name = sTo 'Item.To
objOneRecip.Resolve ' get MAPI to determine complete e-mail address
If Trim(filename) <> "" Then
If Dir(filename) <> "" Then
Set myAttachments = objMessage.Attachments
myAttachments.Add filename, _
olByValue, 1, filename
End If
End If
objMessage.Send showDialog:=False
objSession.Logoff
GoTo eoj
Error_Handler:
MsgBox Err.Description
OutlookMail = EXCH_Program_Error
Resume eoj
eoj:
Set objOneRecip = Nothing
Set myAttachments = Nothing
Set objMessage = Nothing
Set objSession = Nothing
End Function