Sending HTML emails with Attachments via SMTP

This code is basic, but works well.

Sub Initialize
	Dim pdfFilename As String
	pdfFilename = "sample.pdf"
	Dim pdfFilepath As String
	pdfFilepath = "D:\Lotus\"
	'Declare Variables
	Dim s As New NotesSession
	Dim db As NotesDatabase
	Set db = s.CurrentDatabase
	s.ConvertMIME = False 
	' Do not convert MIME to rich text  
	Dim stream As NotesStream
	Set stream = 	s.CreateStream
	Dim message As NotesDocument
	Set message = db.CreateDocument
	message.Form = "memo"
	Dim body As NotesMIMEEntity
	Set body = message.CreateMIMEEntity
	message.Subject = "Sample HTML email via MIME"
	message.INetFrom = " <>"
	message.From = " <>"
	message.Submitter = " <>"
	message.SendTo = ""  
	Set stream = s.CreateStream()
 	'Open the HTML (Title doesn't matter since it doesn't appear anywhere)   
	Call stream.WriteText("<html><head><title>Sample HTML email via MIME</title>")
 	'BEGIN: Inline Stylesheet
	Call stream.WriteText (|
 <style type="text/css">
 .text, td, tr, p, br, body { COLOR: #666666; FONT-FAMILY: Arial, Helvetica, sans-serif; FONT-SIZE: 12px;}
 a { font-family: Arial, Helvetica, sans-serif; color: #663399; FONT-WEIGHT: bold; text-decoration: none;}
 	'END: Inline Stylesheet
	Call stream.WriteText ({</head>})
	Call stream.WriteText ({<body text="#666666" bgcolor="#FFFFFF" leftmargin="0" topmargin="0" marginheight="0" marginwidth="0">})
 ' BEGIN: HTML body
	Call stream.WriteText ({<table width="100%" border="1" cellspacing="0" cellpadding="0" bgcolor="#FFFFFF">Some text here in the table</table>})
	Call Stream.WriteText({some text outiside the table<br>})
	Call stream.WriteText ({</body></html>})
	'Child mime entity which is going to contain the HTML which we put in the stream 
	Dim bodyChild As NotesMimeEntity
	Set bodyChild = body.CreateChildEntity()
	Call bodyChild.SetContentFromText (stream, "text/html;charset=iso-8859-1", ENC_NONE)  
	Call stream.Close
	Call stream.Truncate
	'Committing the stream to the child mime entity - done
	'A new child mime entity to hold a file attachment
	Set bodyChild = body.CreateChildEntity()
	Dim header As NotesMIMEHeader
	Dim host As String
	Set header = bodyChild.createHeader("Content-Type")
	Call header.setHeaderVal("multipart/mixed")
	Set header = bodyChild.createHeader("Content-Disposition")
	Call header.setHeaderVal("attachment; filename=" & pdfFilename) '01-2005.doc should be replaced with the file name of the file you need to attach
	Set header = bodyChild.createHeader("Content-ID")
	Call header.setHeaderVal(pdfFilename) 	'01-2005.doc should be replaced with the file name of the file you need to attach
	Set stream = s.CreateStream()
	If Not stream.Open(pdfFilepath & pdfFilename , "binary") Then
		Print "Open failed"
	End If
	If stream.Bytes = 0 Then
		Print "File has no content"
	End If
	Call bodyChild.SetContentFromBytes(stream, "application/pdf", ENC_IDENTITY_BINARY)
application/msword needs to match
 the file type that you are embedding. 
	'Send the email
	Call message.Send (False)  
	s.ConvertMIME = True ' Restore conversion
End Sub

Written by Frank Joseph Brefere III

Posted by fbrefere001 on Wednesday January 23, 2008