Enviar e-mail contendo HTML

Sub respautomatica(remetente As String,destinatario As String,strHTML As String)
'//Rotina utilizada para enviar e-mail contendo no corpo do e-mail codigo html

On Error Goto ops
Dim s As New NotesSession
Dim memo As New NotesDocument(s.CurrentDatabase)

Dim rtBody As NotesMIMEEntity
Dim rtHtml As NotesMIMEEntity
Dim strmHtml As NotesStream

Set rtBody = memo.CreateMIMEEntity
Set rtHtml = rtBody.CreateChildEntity
Set strmHtml = s.CreateStream
s.ConvertMIME = False ' Do not convert MIME to rich text

Call strmHtml.WriteText(strHTML) '//corpo do e-mail com codigo html
Call rtHtml.SetContentFromText( strmHtml ,"text/html;charset=iso-8859-1", ENC_NONE )

'//Criando o E-Mail
With memo
.Form = "Memo"
.Principal = remetente
' .SMTPOriginator = remetente
.From = remetente
.AltFrom = remetente
.SendTo = remetente
.SentBy = remetente
' .INetFrom = remetente
' .tmpDisplayFrom_Preview = remetente
' .tmpDisplaySentBy = remetente
'' .tmpDisplayReplyInfo = remetente
' .tmpDisplayFrom_NoLogo = remetente
.Subject = assunto
.SendTo = destinatario
.RecNoOutOfOffice = "1" 'Set it so out of office agents don't reply to the message
.SaveMessageOnSend = False
End With

Call memo.Send( False )
s.ConvertMIME = True

sai:
Exit Sub
ops:
Msgbox "Erro na função respautomatica na linha " & Erl & " do tipo:" & Error & Err
Resume sai
End Sub