Sending formatted Lotus Notes rich text email from Excel VBA
- by Lunatik
I have little Lotus Script or Notes/Domino knowledge but I have a procedure, copied from somewhere a long time ago, that allows me to email through Notes from VBA. I normally only use this for internal notifications where the formatting hasn't really mattered.
I now want to use this to send external emails to a client, and corporate types would rather the email complied with our style guide (a sans-serif typeface basically).
I was about to tell them that the code only works with plain text, but then I noticed that the routine does reference some sort of CREATERICHTEXTITEM object. Does this mean I could apply some sort of formatting to the body text string after it has been passed to the mail routine? As well as upholding our precious brand values, this would be quite handy to me for highlighting certain passages in the email.
I've had a dig about the 'net to see if this code could be adapted, but being unfamiliar with Notes' object model, and the fact that online Notes resources seem to mirror the application's own obtuseness, meant I didn't get very far.
The code:
Sub sendEmail(EmailSubject As String, EMailSendTo As String, EMailBody As String, MailServer as String)
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesField As Object
Dim sendmail As Boolean
'added for integration into reporting tool
Dim dbString As String
dbString = "mail\" & Application.UserName & ".nsf"
On Error GoTo SendMailError
'Establish Connection to Notes
Set objNotesSession = CreateObject("Notes.NotesSession")
On Error Resume Next
'Establish Connection to Mail File
Set objNotesMailFile = objNotesSession.GETDATABASE(MailServer, dbString)
'Open Mail
objNotesMailFile.OPENMAIL
On Error GoTo 0
'Create New Memo
Set objNotesDocument = objNotesMailFile.createdocument
Dim oWorkSpace As Object, oUIdoc As Object
Set oWorkSpace = CreateObject("Notes.NotesUIWorkspace")
Set oUIdoc = oWorkSpace.CurrentDocument
'Create 'Subject Field'
Set objNotesField = objNotesDocument.APPENDITEMVALUE("Subject", EmailSubject)
'Create 'Send To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("SendTo", EMailSendTo)
'Create 'Copy To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("CopyTo", EMailCCTo)
'Create 'Blind Copy To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("BlindCopyTo", EMailBCCTo)
'Create 'Body' of memo
Set objNotesField = objNotesDocument.CREATERICHTEXTITEM("Body")
With objNotesField
.APPENDTEXT emailBody
.ADDNEWLINE 1
End With
'Send the e-mail
Call objNotesDocument.Save(True, False, False)
objNotesDocument.SaveMessageOnSend = True
'objNotesDocument.Save
objNotesDocument.Send (0)
'Release storage
Set objNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
'Set return code
sendmail = True
Exit Sub
SendMailError:
Dim Msg
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
sendmail = False
End Sub
