Search code examples
lotus-noteslotusscriptlotus

Controlling order of HTML and Attachments on email using MIME

My DB has some Notes Documents which are email templates. They have a name, a field for one attachment, and a field for html.

I am trying to code an agent that can grab this document and construct an internal email that will have the html and the attachment.

My code works but the email looks like this:

enter image description here

I do not want the attachment up at the top. I would prefer to have it embedded in the html. When I grab the html text I replace some values, like the user's name, so the emails can be dynamic. I just put "|REPLACE1|" where I want the user's name to be put in. Is there a way to write the html with a "|FILEREPLACE1|" so that I can then attach the file dynamically?

If not, can I put the attachment at the bottom of the email somehow?

LS Class "ClsEmail"

%REM
    Library ClsEmail
    Created Dec 4, 2016 by Bryan Schmiedeler/Scoular
    Description: Comments for Library
%END REM
Option Public
Option Declare

Const ERR_EMAIL_MODIFICATION_NOT_ALLOWED = "You can not make changes to an email once it has been sent."

Dim emlView As NotesView
Dim emlDoc As NotesDocument
Dim object As NotesEmbeddedObject
Dim docUNID As String
Dim fleNme As String

Dim bodyChild As NotesMIMEEntity 
Dim hdr As NotesMIMEHeader 
Dim Success As Boolean

Class Email

        Private session As NotesSession
        Private doc As NotesDocument
        Private body As NotesMIMEEntity
        Private mh As NotesMIMEHeader
        Private mc As NotesMIMEEntity
        Private ma 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.elmTrmDoc = nothing
                'Set me.unid = ""
                Set Me.doc = Me.session.Currentdatabase.CreateDocument
                Me.doc.Form = "Memo"

                Me.FromName(0) = "Sender's Name"
                Me.FromName(1) = "[email protected]"
                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

        Property Set Subject As String
                Me.doc.subject = subject
        End Property

        Property Set unid As String
                Me.unid = unid
        End Property

        Property Set Plain
                Me.str_TextPart = Plain
                Me.isTextSet = True

                Me.isRebuildNeeded = True
        End Property

        Property Get Plain
                Plain = Me.str_TextPart
        End Property

        Property Set HTML
                Me.str_HTMLPart = HTML
                Me.isHTMLSet = True          
                Me.isRebuildNeeded = True
        End Property

        Property Get HTML
                HTML = Me.str_HTMLPart
        End Property

        Property Set Styles As String
                Me.str_Styles = Styles
                Me.isStyleSet = True

                Me.isRebuildNeeded = True
        End Property

        Property Set CSS As String
                Me.Styles = CSS
        End Property

        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

        Property Set ReplyTo As String
                Me.Doc.ReplyTo = ReplyTo

                Me.isRebuildNeeded = True
        End Property

        Property Set CopyTo As String
                Me.Doc.CopyTo = CopyTo

                Me.isRebuildNeeded = True
        End Property

        Property Set BlindCopyTo As String
                Me.Doc.BlindCopyTo = BlindCopyTo

                Me.isRebuildNeeded = True
        End Property

        Sub Rebuild

                If Me.doc.HasItem("Body") Then
                        Call Me.doc.RemoveItem("Body")
                End If

                If Me.isHTMLSet Then 'Send mulipart/alternative 

                        'Create the MIME headers

                        Me.session.convertMIME = False 
                        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_="})

                        '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(Replace(Me.str_HTMLPart, ">", ">"+Chr(10)))
                        Call stream.WriteText(Me.str_HTMLPart)

                        'Extract Attachment and add to this email
                        Set emlView = Me.session.Currentdatabase.Getview("xpViewEmailsAll")
                        Set emlDoc = emlView.getFirstDocument
                        Dim obj As NotesEmbeddedObject
                        Set obj = emlDoc.GetAttachment("To Terminate an Employee (manager).pdf")
                        fleNme = "c:/temp/" + obj.Name()
                        Call obj.ExtractFile(fleNme)
                        Set bodyChild = Me.body.Createchildentity()
                        Success = MimeAttachFileAsBase64(bodyChild,"c:/temp/",obj.Name())

                        'Remove File
                        'Kill fleNme

                        Call Me.mc.setContentFromText(Me.stream, {text/html;charset="iso-8859-1"}, ENC_NONE)
                        Call Me.doc.Closemimeentities(True)
                        Me.session.convertMIME = True 
                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


        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
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 bodyChild As NotesMIMEEntity
Dim header As NotesMIMEHeader
Dim sContentType As String
Dim MimeAttachFile As Boolean

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 bodyChild = mime.CreateChildEntity()
sContentType = |application/octet-stream| 
Call bodyChild.SetContentFromBytes (nsFile,sContentType & |; name="| & sFileName & |"|, ENC_NONE)
Call bodyChild.EncodeContent(ENC_BASE64)
Set header = bodyChild.createHeader("Content-Disposition")
Call header.SetHeaderVal(|attachment; filename="| & sFileName & |"|)
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

Agent Code:

Sub Initialize

    Dim session As New NotesSession
    Dim doc As NotesDocument
    Dim db As NotesDatabase
    Dim emlView As NotesView
    Dim emlDoc As NotesDocument
    Dim rti As NotesRichTextItem
    Dim unfTxt As String
    Dim unfTxt2 As String
    Dim empNme As String
    Dim docUNID As String

    Set db = session.CurrentDatabase
    Dim agent As NotesAgent
    Set agent=session.Currentagent

    'Get a handle On term
    Set doc = db.GetDocumentByUnid("D321286EADF83DA78625807C006A7A84")
    'Set doc = db.GetDocumentByID(agent.ParameterDocID)

    'Get a handle on HTML Doc
    Set emlView = db.Getview("xpViewEmailsAll")
    Set emlDoc = emlView.getFirstDocument
    unfTxt = emlDoc.emlBdyTxt(0)

    empNme = doc.EmployeeName(0)
    docUNID = emlDoc.Universalid

    'Run REPLACE1   
    unfTxt2 = ReplaceSubstring(unfTxt,"|REPLACE1|",empNme)  

    Dim mail As New Email()
    mail.Subject = "Termination Notification for " + empNme 
    mail.HTML = unfTxt2
    mail.CSS = "p{margin:2em}"
    mail.Sender = Split("IT Help Desk,[email protected],Scoular", ",")
    mail.unid = docUNID
    mail.Send("[email protected]")

End Sub
Solution

  • I love that Email class! Great concept. I wish it worked for you.

    I don't have an answer, but I might have a solution? If you can, I highly recommend that you change your email so that instead of an attachment you have a link where it's centrally stored! Why create duplicates if, as you've said, it's internal email?

    You could link to /DatabasePath/xpViewEmailsAll/$First/$File/To%20Terminate%20an%20Employee%20(manager).pdf but I'd recommend that you instead link to /Database/AttachmentRequests/To%20Terminate%20an%20Employee%20(manager).pdf where "AttachmentRequests" is a view with a form formula, the first sorted column contains the name of each file offered, and the specified form intercepts the open and launches the attachment itself instead. That way it can work for Notes or web clients and, when the need arises in some predictably chaotic future, you'll be able to change the behavior to instead report "THIS HAS MOVED" or possibly forward them to the correct page on some yet-to-exist intranet site.