Updated HTML Email LotusScript Class
Following feedback on my post earlier I made some changes and fixed some logical issues with the Email class. If you were thinking about using the code I posted yesterday, don't. It doesn't even work, really.
The updated class doesn't mind if you set the HTML or the Text part of the email first. Nor does it mind if you only set the text part - in which case it won't use MIME at all.
Also, as per your suggestions, you can now set the CopyTo field on the email and you can also extend the default styles with the CSS property of the Email object.
Example of use:
Dim mail as New Email() mail.Subject = "A multipart email" mail.Plain = "This is plain text" mail.HTML = "<p>This is <i>fancy</i> text</p>" mail.HTML = mail.HTML + "<p>Woops. Forgot this</p>" mail.CSS = "p{margin:2em}" mail.Send("me@home.com")
Although the following will work if you just want to send a quick text-only email:
Dim mail as New Email() mail.Subject = "A quicky" mail.Plain = "This is plain text" mail.Send("me@home.com")
As with yesterday's code you can over-ride default sender's/from name like so:
mail.Sender = Split("Foo Bar, foo@bar.com, DOMAIN", ", ")
Here's the updated code for the class.
Const ERR_EMAIL_MODIFICATION_NOT_ALLOWED = "You can not make changes to an email once it has been sent." Class Email Private session As NotesSession Private doc As NotesDocument Private body As NotesMIMEEntity Private mh As NotesMIMEHeader Private mc As NotesMIMEEntity Private stream As NotesStream Private isTextSet As Boolean Private isHTMLSet As Boolean Private isStyleSet As Boolean Private isRebuildNeeded As Boolean Private isMailBuilt As Boolean Private rtitem As NotesRichTextItem Private str_TextPart As String Private str_HTMLPart As String Private str_DefaultStyles As String Private str_Styles As String Private FromName(0 To 2) As String Sub New() Set Me.session = New NotesSession() Set Me.doc = Me.session.Currentdatabase.CreateDocument Me.doc.Form = "Memo" Me.FromName(0) = "Sender's Name" Me.FromName(1) = "foo@bar.net" Me.FromName(2) = "DOMAIN" Me.str_DefaultStyles = "body{margin:10px;font-family:verdana,arial,helvetica,sans-serif;}" Me.isTextSet = False Me.isHTMLSet = False Me.isRebuildNeeded = True Me.isMailBuilt = False End Sub %REM Property Set Subject Description: Comments for Property Set %END REM Property Set Subject As String Me.doc.subject = subject End Property %REM Sub setTextPart Description: Comments for Sub %END REM Property Set Plain Me.str_TextPart = Plain Me.isTextSet = True Me.isRebuildNeeded = True End Property Property Get Plain Plain = Me.str_TextPart End Property %REM Sub setHTMLPart Description: Comments for Sub %END REM Property Set HTML Me.str_HTMLPart = HTML Me.isHTMLSet = True Me.isRebuildNeeded = True End Property Property Get HTML HTML = Me.str_HTMLPart End Property %REM Sub Styles Description: Comments for Sub %END REM Property Set Styles As String Me.str_Styles = Styles Me.isStyleSet = True Me.isRebuildNeeded = True End Property %REM Sub CSS Description: Shortcut sub to Styles %END REM Property Set CSS As String Me.Styles = CSS End Property %REM Sub setFromAddress Description: Comments for Sub %END REM Property Set Sender As Variant Me.FromName(0) = Sender(0) Me.FromName(1) = Sender(1) Me.FromName(2) = Sender(2) Me.isRebuildNeeded = True End Property %REM Property Set replyTo Description: Comments for Property Set %END REM Property Set ReplyTo As String Me.Doc.ReplyTo = ReplyTo Me.isRebuildNeeded = True End Property %REM Property Set CopyTo Description: Comments for Property Set %END REM Property Set CopyTo As String Me.Doc.CopyTo = CopyTo Me.isRebuildNeeded = True End Property %REM Property Set BlindCopyTo Description: Comments for Property Set %END REM Property Set BlindCopyTo As String Me.Doc.BlindCopyTo = BlindCopyTo Me.isRebuildNeeded = True End Property %REM Sub Rebuild Description: Comments for Sub %END REM Sub Rebuild If Me.doc.HasItem("Body") Then Call Me.doc.RemoveItem("Body") 'Is this needed to allow rebuilding between sends? 'Set Me.body = Me.Doc.GetMIMEEntity( "Body" ) 'If Me.body Is Nothing Then ' MsgBox "can't find mime entity" 'End If 'Call Me.body.Remove() End If If Me.isHTMLSet Then 'Send mulipart/alternative 'Create the MIME headers Me.session.convertMIME = False 'This is the line that errors if you try and rebuild the message between sends! 'Error = "Object varaible not set" Set Me.body = Me.doc.CreateMIMEEntity("Body") Set Me.mh = Me.body.CreateHeader({MIME-Version}) Call Me.mh.SetHeaderVal("1.0") Set Me.mh = Me.body.CreateHeader("Content-Type") Call Me.mh.SetHeaderValAndParams( {multipart/alternative;boundary="=NextPart_="}) 'Send the text part first If Me.isTextSet Then Set Me.mc = Me.body.createChildEntity() Set Me.stream = Me.session.createStream() Call Me.stream.WriteText(Me.str_TextPart) Call Me.mc.setContentFromText(Me.stream, {text/plain}, ENC_NONE) End If 'Now send the HTML part. Order is important! Set Me.mc = Me.body.createChildEntity() Set Me.stream = Me.session.createStream() Set Me.mc = Me.body.createChildEntity() Call stream.WriteText("<html>", EOL_CR) Call stream.WriteText("<head>", EOL_CR) Call stream.WriteText("<style>", EOL_CR) Call stream.WriteText(Me.str_DefaultStyles, EOL_CR) If Me.isStyleSet Then Call stream.WriteText(Me.str_Styles, EOL_CR) End If Call stream.WriteText("</style>", EOL_CR) Call stream.WriteText("</head>", EOL_CR) Call stream.WriteText("<body>", EOL_CR) Call stream.WriteText(Replace(Me.str_HTMLPart, ">", ">"+Chr(10))) Call stream.WriteText("</body>", EOL_CR) Call stream.WriteText("</html>", EOL_CR) Call Me.mc.setContentFromText(Me.stream, {text/html;charset="iso-8859-1"}, ENC_NONE) Call Me.doc.Closemimeentities(True) Me.session.convertMIME = True ElseIf Me.isTextSet Then 'Just Text will do! Set Me.rtitem = New NotesRichTextItem(Me.doc, "Body") Me.rtitem.Appendtext(me.Str_TextPart) Else 'No content! Error 1000, ERR_EMAIL_NO_CONTENT End If Me.doc.Principal= Me.FromName(0) +" <"+Me.FromName(1)+"@"+Me.FromName(2)+">" Me.doc.InetFrom = Me.FromName(0) +" <"+Me.FromName(1)+">" Me.isMailBuilt = True Me.isRebuildNeeded = False End Sub %REM Sub Send Description: Comments for Sub %END REM Sub Send(sendTo As String) If Me.isMailBuilt And Me.isRebuildNeeded Then Error 1000, ERR_EMAIL_MODIFICATION_NOT_ALLOWED ElseIf Not Me.isMailBuilt then Call Me.Rebuild() End If Me.Doc.SendTo = SendTo Call Me.Doc.Send(False) End Sub End Class
There's still room for improvement. If I get time I'll try and address the following:
- Work out why it won't let you change/rebuild the content between multiple calls to the Send method.
- Add support for inline images/attachments
- Add some basic templating.
- Documentation/better commenting?
- Sample database?
Finally I want to thank Peter LaComb for the one-on-one tutoring he gave me!
Hi Jake,
Adding attachments to a HTML mail isn't too difficult, but I only got it to work by extracting the files that need to be attached to a temporary directory on the filesystem first. As I recall it isn't possible in LotusScript to create a NotesStream object from a document attachment directly.
The code I use looks something like this (lstFileAttachments is a string list containing the full path to a number of files):
dim strContentType$
Forall file In lstFileAttachments
Select Case Lcase(Strright(file, ".") )
Case "gif"
strContentType = "image/gif"
Case "jpeg", "jpg"
strContentType = "image/jpeg"
Case Else
strContentType = "application/octet-stream"
End Select
Set Me.mc = Me.body.createChildEntity()
Set Me.mh = Me.mc.CreateHeader("Content-Disposition")
Call Me.mh.SetHeaderVal({attachment; filename="} & Listtag(file) & {"} )
'only required if we're embedding something we need to reference later on
'Set Me.mh = Me.mc.CreateHeader("Content-ID")
'Call Me.mh.SetHeaderVal( |<| & Listtag(file) & |>| )
Set streamFile = ttSession.s.CreateStream
If streamFile.Open(file) Then
Call Me.mc.SetContentFromBytes(streamFile, strContentType & {; name="} & Listtag(file) & {"}, ENC_IDENTITY_BINARY)
Call streamFile.Close
End If
End Forall
Reply
Thanks Mark. I'll use that as a starting point. Do you know how you'd reference an image file in the subsequent HTML?
Reply
Show the rest of this thread
You can get attachments from a document directly into a stream, but you have to set the richtext field on the form to store contents as HTML & MIME. Combine that with a computed field that stores @AttachmentNames, and you can search MimeEntity for an entity with a content-type header having the name attribute equal to your filename.
Reply
Yes. For inline images you'll have to change a few things:
- Set the content-disposition to inline. Change:
Set Me.mh = Me.mc.CreateHeader("Content-Disposition")
Call Me.mh.SetHeaderVal( |attachment; filename="your_image.png"| )
to:
Set Me.mh = Me.mc.CreateHeader("Content-Disposition")
Call Me.mh.SetHeaderVal( |inline; filename="your_image.png"| )
- Add a Content-ID header for every inline image:
Set Me.mh = Me.mc.CreateHeader("Content-ID")
Call Me.mh.SetHeaderVal( |<your_image.png>| )
- Add a reference to the image in the HTML code:
<img src="cid:your_image.png">
I've noticed that (at least in Outlook) if you don't add the reference in the HTML the image is show as an attachment. If the reference is present the image is hidden from the list of attachments.
Reply
Glad I could help you out Jake - it's the least I can do to support the great work you do on this site.
Reply
Good post.
Thanks for sharing this content.
Reply
Here is the simple way to attach (and base64 encode) a file to MIME.
Function MimeAttachFileAsBase64(mime As NotesMimeEntity, sFolderPath As String, sFileName As String) As Boolean
On Error Goto ERRHANDLER
Dim sess As New NotesSession
Dim nsFile As NotesStream
Dim mimeChild As NotesMimeEntity
Dim mimeheader As NotesMimeHeader
Dim sContentType As String
MimeAttachFile = False
Set nsFile = sess.CreateStream()
If Not nsFile.Open(sFolderPath & sFileName, "Binary") Then
Print "MimeAttachFileAsBase64 Error: Failed to open file: " & sFolderPath & sFileName
Err = 0
Exit Function
End If
Set mimeChild = mime.CreateChildEntity()
sContentType = |application/octet-stream| ' application/octet-stream is a default value
Call mimeChild.SetContentFromBytes( nsFile, sContentType & |; name="| & sFileName & |"|, ENC_NONE)
' base64 encode the file
Call mimeChild.EncodeContent( ENC_BASE64)
' Content-Disposition header
Set mimeheader = mimeChild.createHeader("Content-Disposition")
Call mimeheader.SetHeaderVal(|attachment; filename="| & sFileName & |"|)
' close stream and cleanup
Call nsFile.Close()
Set nsFile = Nothing
MimeAttachFile = True
Exit Function
ERRHANDLER:
Print "MimeAttachFileAsBase64 Error: " & Format$(Err) & " " & Error & " # Line: " & Format$(Erl)
Err = 0
Exit Function
End Function
Reply
Great code. One error it needs the constant ERR_EMAIL_NO_CONTENT
I would also suggest adding an options to using a different database and saving the document.
Reply
@Jake: "Work out why it won't let you change/rebuild the content between multiple calls to the Send method"
If you're "reusing" the same class variables, then it may not work (in classes I suspect). I'm no guru with Classes - I'm simply a beginner in that area.
You might need to "redim"/"reset" the object(s) variables in order to rebuild the content ... I had this problem when using a "Web Service Consumer" - I couldn't reuse the same variable within the same function call.
ie:
/* code that does not work when using webservice classes */
Dim thisValue as new XSD_String
thisValue.setValueFromString( "25" )
Set theObject.classVariable1 = thisValue
thisValue.setValueFromString( "35" )
Set theObject.classVariable2 = thisValue
Using the above code, my "Web Service Consumer" agent said that theObject.classVariable1's value is 35 - not 25!
To fix this:
/* code that works when using webservice classes */
Dim thisValue1 as new XSD_String
thisValue1.setValueFromString( "25" )
Set theObject.classVariable1 = thisValue1
Dim thisValue2 as new XSD_String
thisValue2.setValueFromString( "35" )
Set theObject.classVariable2 = thisValue2
Now, theObject.classVariable1's value is 25 and theObject.classVariable2's value is 35.
Reply
Thanks Richard. I'm no class-writing expert either. I'll have a go at what you're suggesting and see where I get.
Reply
I can confirm that moving "Dim mail as New Email()" inside the loop works.
Thanks again jake, Sean
Reply
Class veruy useful
I comment just for testing you
thanks for yuor work
Reply
just for testing
Reply
yes
Reply
Hi Jake, thanks for the class, I really need to learn this stuff better, could you also extend to use the bcc field as we have users that like to reply to all with history, all the time and using this field helps to stop the email being sent to all and sundry when they reply.
Reply
CC and BCC is already there Tony. Just use:
mail.CopyTo = "me@me.com"
mail.BlindCopyTo = "you@you.com"
Jake
Reply
Show the rest of this thread
Hi Jake,
Is it possible to embed images when sending mail as HTML using this class ?
Reply
Hi Peter. Read the first comment thread above for ideas.
Reply
Jake-
Have you found a good method for replying/forwarding HTML emails with the original text in LotusScript?
Reply
Thanks, Jake, for a great tool.
I'm going to take this, throw in some wrapper code for error trapping (using Julian Rubichaux's OpenLog.ntf), and plunk into our Master Design Elements Template, which we deploy to all our other applications.
Thanks for all your hard work!
John
Reply
Glad you like it John. If you find any way to improve it, feel free to share!
BTW: You might want to read this too:
http://codestore.net/store.nsf/unid/BLOG-20100303-0114
Reply
Show the rest of this thread
Hi Jake,
I tried your code to produce a multi-part MIME newsletter, but with embedded internal images, so the mail contains all. I made some extensions, I'll post them below, but somehow I just can't get it right. Could you help me out, and at the same time expand the capabilities of the existing code? Would be great!
Code I added as methods in the class:
Private images() As String
Private nimages As Integer
Sub EmbedImage(file As String)
Dim ContentType As String
Dim streamFile As NotesStream
Dim filename As String
Redim Preserve images(nimages)
images(nimages)= file
nimages= nimages+1
filename= Strrightback(file, "\")
If Instr(file, "/") Then filename= Strrightback(file, "/")
Me.HTML= Me.HTML + |<img src="cid:image_| & nimages & |">|
End Sub
Private Sub AttachImage(file As String)
Dim ContentType As String
Dim streamFile As NotesStream
Dim filename As String
Dim n As Integer
filename= Strrightback(file, "\")
If Instr(file, "/") Then filename= Strrightback(file, "/")
Select Case Lcase(Strright(filename, ".") )
Case "gif"
ContentType = "image/gif"
Case "jpeg", "jpg"
ContentType = "image/jpeg"
Case Else
ContentType = "application/octet-stream"
End Select
Set Me.mc= Me.body.createChildEntity()
Set Me.mh = Me.mc.CreateHeader("Content-Disposition")
Call Me.mh.SetHeaderVal({inline; filename="} & filename & {"} )
'only required if we're embedding something we need to reference later on
Set Me.mh = Me.mc.CreateHeader("Content-ID")
n= n + 1
Call Me.mh.SetHeaderVal( |<image_| & n & |>| )
Set streamFile = session.CreateStream
If streamFile.Open(file) Then
Call Me.mc.SetContentFromBytes(streamFile, ContentType & {; name="} & filename & {"}, ENC_IDENTITY_BINARY)
Call streamFile.Close
End If
End Sub
and then in the Rebuild, I added just before the line with
Call Me.doc.Closemimeentities(True)
this code
Forall image In images
Call AttachImage(image)
End Forall
Here's how I use the class:
Sub Initialize
Dim mail As New Email()
mail.Subject = "A multipart email generated " & Now
mail.Sender= Split("Sjef Bosman;me@mememe.fr;TCM", ";")
mail.Plain = "This is plain text"
mail.HTML = "<p>This is <i>fancy</i> text</p>"
mail.EmbedImage "c:\Windows\Cloud.gif" ' some image
mail.HTML = mail.HTML + "<p>Woops. Forgot this</p>"
mail.CSS = "p{margin:2em}"
mail.Send("me@mememe.fr")
End Sub
If I set the output to multipart/mixed, I see the embedded image exactly where it's supposed to be. But the plain text is also there...
Can you help me??
Many thanks!
Sjef
Reply
Is there a way to have the send command use an address outside of the domino server? Right now if I use an agent to send an email using the above class it comes across as me, becuase (I am guessing) I was the last one to sign the agent.
Is there a way to send it from Generic Tracker@myhost.com?
Great class! Super useful!
Thanks for the help.
Reply
Hi Kris,
See the FromName variable in the "New" routine and also the "Sender" setter to set it.
Jake
Reply
Show the rest of this thread
Jake-
Been using this class for awhile now, works great. I ran into an issue where droid users were reporting blank emails being delivered to them.
I tracked it down to this section of code in sub rebuild:
'Now send the HTML part. Order is important!
Set Me.mc = Me.body.createChildEntity() <--- why is this line here??
Set Me.stream = Me.session.createStream()
Set Me.mc = Me.body.createChildEntity()
There appears to be an unnecessary createChildEntity that has no content.
Which gives me this when I look at the source message:
--=NextPart_=
--=NextPart_=
Content-Type: text/html;charset="iso-8859-1"
<html>
<head>
Reply