I am sending an Internet e-mail through a LotusScript agent, but the graphics are not appearing in the e-mails. The body of the e-mail is maintained in a rich-text field in a document by the users. The field name is Body and the setting “Store contents as HTML and MIME” is checked. The agent uses the NotesMIMEEntity methods and properties. The content of the Body field is retrieved in the agent for display in the e-mail. When the e-mail is received, the rich text appears okay, but the graphics appear as the red X. The code at the bottom of the agent for creating the link for unsubscribing works fine.
This is the first time I have used the NotesMIMEEntity class so I probably have some code that is not correct. Please take a look at the code in my agent below , and let me know what I may need to change. Thank you.
'*************************************************************************
'Sends e-mail to all addresses in subscription list for this list profile
'Also provides link for unsubscribing to this list
'*************************************************************************
Dim session As New NotesSession
Dim workspace As New NotesUIWorkspace
Dim db As NotesDatabase
Dim uidoc As NotesUIDocument
Dim doc, lkupdoc, maildoc, errdoc, pdoc As NotesDocument
Dim view, view2 As NotesView
Dim dc As NotesDocumentCollection
Dim msg, unsubscribeLink As Variant
Dim rtitem As Variant
Dim rtitem2 As NotesRichTextItem
Dim char As String
Dim counter As Integer
Dim svr As String
Dim filePath As String
Dim listMail As String
Dim body As NotesMimeEntity
Dim mime As NotesMimeEntity
Dim child As NotesMimeEntity
Dim parent As NotesMimeEntity
Dim content As NotesItem
Dim stream As NotesStream
Dim header As NotesMimeHeader
session.ConvertMime = False
Set db = session.CurrentDatabase
Set uidoc = workspace.CurrentDocument
Set doc = uidoc.Document
Set stream = session.CreateStream
Set view = db.GetView(“Subscriptions”)
Set dc = view.GetAllDocumentsByKey(doc.Title(0),True)
Set lkupdoc = dc.GetFirstDocument
counter = 0
Do Until lkupdoc Is Nothing
'send e-mail
char = Instr(1,lkupdoc.Email(0),"@")
If char > 0 Then
Set maildoc = db.CreateDocument
maildoc.Form = "Memo"
maildoc.Subject = doc.Subject(0)
maildoc.SendTo = lkupdoc.Email(0)
'setting Principal requires using domain name twice and using CreateHeader below
'otherwise, the e-mail comes from the e-mail address of the person clicking the Send button
'setting the Principal also has to be done here and can't be done under the 'Set body' line
maildoc.Principal = "corpcom@westarenergy.com@westarenergy.com"
'Open the HTML (Title doesn't matter since it doesn't appear anywhere)
Set body = maildoc.CreateMIMEEntity
Set header=body.CreateHeader("Principal")
'begin inline stylesheet
Call stream.WriteText("<html><head><title>HTML e-mail using MIME</title>")
Call stream.WriteText(|<style type="text/css"><!-- .text,td,tr,p,br,body {COLOR: #000000;FONT-FAMILY: Arial,Helvetica,sans-serif; FONT-SIZE: 12px;} a {font-family:Arial, Helvetica, sans-serif; color: #663399; FONT-WEIGHT: bold; text-decoration: underline;}--></style>|)
'end inline stylesheet
'begin HTML body
Call stream.WriteText("<body>")
Call stream.WriteText("<br>")
'get content of Body field from content management document
'setting "Store contents as HTML and MIME" is checked on the Body field
Set content = doc.GetFirstItem("Body")
If content.Type = MIME_PART Then
Set mime = content.GetMIMEEntity
If mime.ContentType = "multipart" Then
Set child = mime.GetFirstChildEntity
While Not(child Is Nothing)
If child.ContentType = "image" Then
If child.ContentSubType = "gif" Then
Call child.SetContentFromBytes(stream,"image/gif", ENC_NONE)
Call child.EncodeContent(ENC_BASE64)
End If
If child.ContentSubType = "jpeg" Then
Call child.SetContentFromBytes(stream,"image/jpeg",ENC_NONE)
Call child.EncodeContent(ENC_BASE64)
End If
Else
Call child.GetContentAsText(stream)
End If
Set child = child.GetNextSibling
Wend
End If
Else
Call stream.WriteText(doc.GetItemValue("Body")(0),EOL_CRLF)
End If
'add link for unsubscribing
Call stream.WriteText("<br><br><br>")
Set pdoc = db.GetProfileDocument("Profile")
svr = pdoc.Server2(0)
filePath = Replace(db.FilePath,"\","/")
listMail = Replace(doc.Title(0)," ","%20") & "~" & lkupdoc.Email(0)
Call stream.WriteText({To remove your name from this e-mail list, <a href="http://} + svr + {/} + filePath +{/unsubscribe?openagent&listmail=} + listMail + {">click here</a>.})
Call stream.WriteText("<br><br>")
Call stream.WriteText({If you are unable to access the above link, copy and paste the following link into your browser's address bar:})
Call stream.WriteText("<br>")
Call stream.WriteText("http://" & svr & "/" & filePath & "/unsubscribe?openagent&listmail=" & listMail)
Call stream.WriteText("<br><br>")
Call stream.WriteText("</body></html>")
'end HTML body
'ensure the MIME content is recognized as HTML
Call body.SetContentFromText(stream,"text/html",ENC_NONE)
Call stream.Close
Call stream.Truncate
Call maildoc.Send(False)
counter = counter + 1
End If
Set lkupdoc = dc.GetNextDocument(lkupdoc)
Loop
session.ConvertMime=True
doc.SentDate = Now
Call doc.Save(True,True)
Messagebox counter & " e-mails have been sent.",64,"Mail Sent"
Set view2 = db.GetView("ListProfiles")
Call view2.Refresh
Call uidoc.Close
End Sub