ModelEmail.cls

Option Explicit

Public Enum EMAIL_STORECOPY
    NOSTORE = 0
    STORE = 1
End Enum

Private pSubject As String
Private pBodyText As String

Private pBlindCopyTo As New Collection
Private pCopyTo As New Collection
Private pRecipients As New Collection

Private pAttachments As New Collection
Private pKeepCopy As EMAIL_STORECOPY

Private pPassword As String
Private pLoginID As String

Private pMailDoc As Object

Dim pLotusSession As NotesSession
Dim pDB As Object

' NOTE: INCLUDE LOTUS DOMINO OBJECT REFERENCE BEFORE USING

Public Sub Class_Initialize()
    pLoginID = Environ("USERNAME")
End Sub

' --- Public Functions

Public Sub sendEmail(password As String)
    
    initializeDB password
    initializeMaildoc
    pMailDoc.SEND False
    cleanup

End Sub

Public Sub addAttachment(attachment As String)
    pAttachments.Add attachment
End Sub

Public Sub addRecipient(recipient As String)
    pRecipients.Add recipient
End Sub

Public Sub addBCC(recipient As String)
    pBlindCopyTo.Add recipient
End Sub

Public Sub addCC(recipient As String)
    pCopyTo.Add recipient
End Sub

' --- Getters

Public Property Get subject() As String
    subject = pSubject
End Property

Public Property Get bodyText() As String
    bodyText = pBodyText
End Property

Public Property Get keepCopy() As EMAIL_STORECOPY
    Set keepCopy = pKeepCopy
End Property

Public Property Get loginID() As String
    loginID = pLoginID
End Property

' --- Setters

Public Property Let subject(value As String)
    pSubject = value
End Property

Public Property Let bodyText(value As String)
    pBodyText = value
End Property

Public Property Let keepCopy(value As EMAIL_STORECOPY)
    Set pKeepCopy = value
End Property

Public Property Let loginID(value As String)
    pLoginID = value
End Property

' --- Private Functions

Private Sub initializeDB(password As String)

    Set pLotusSession = New NotesSession
    pLotusSession.Initialize (password)
    
    Dim dbName As String
    dbName = pLoginID & ".nsf"
    
    Set pDB = pLotusSession.GetDatabase("", "C:\Notes\Data\Mail\" & dbName)
    If Not pDB.isopen Then pDB.OPENMAIL

End Sub

' Purpose: Creates the Lotus Notes email object and initializes
Private Sub initializeMaildoc()

    Set pMailDoc = pDB.CREATEDOCUMENT()
    
    pMailDoc.ReplaceItemValue "Form", "Memo"
    
    If pRecipients.count > 0 Then pMailDoc.ReplaceItemValue "sendTo", getRecipients(pRecipients)
    If pBlindCopyTo.count > 0 Then pMailDoc.ReplaceItemValue "copyTo", getRecipients(pBlindCopyTo)
    If pCopyTo.count > 0 Then pMailDoc.ReplaceItemValue "blindCopyTo", getRecipients(pCopyTo)
            
    pMailDoc.ReplaceItemValue "subject", pSubject
    pMailDoc.ReplaceItemValue "Body", pBodyText
    pMailDoc.ReplaceItemValue "PostedDate", Now()
    pMailDoc.SAVEMESSAGEONSEND = pKeepCopy
    
    initializeAttachments

End Sub

' Purpose: Converts a collection of attachment strings to maildoc attachment items, and attaches them to
'          the maildoc item.
Private Sub initializeAttachments()

    If pAttachments.count = 0 Then Exit Sub

    Dim oAttachment As Object
    Set oAttachment = pMailDoc.CREATERICHTEXTITEM("Attachment")

    Dim filePath As Variant, oEmbed As Object, i As Integer, attachName As String
    For Each filePath In pAttachments
    
        i = i + 1
        attachName = "attachment" & i
        Set oEmbed = oAttachment.EMBEDOBJECT(1454, "", filePath, attachName)
    
    Next filePath

End Sub

' Purpose: Converts collection of recipients to an array for ingestion by MailDoc
' @param Collection recipients - A collection to be converted to an array
Private Function getRecipients(recipients As Collection) As Variant()

    ReDim recipArray(recipients.count - 1) As Variant
    
    Dim recipient As Variant, i As Integer
    For i = 0 To recipients.count - 1
        recipArray(i) = recipients(i + 1)
    Next i
    
    getRecipients = recipArray

End Function

Private Sub cleanup()

    Set pMailDoc = Nothing
    Set pDB = Nothing
    Set pLotusSession = Nothing

End Sub