Send Lotus Notes email with attachment via VBA

[Paul_Hossler]

Trying to help someone who uses Lotus Notes and wants to have VBA generate a workbook to be attached to an email and then send the email

I don't have Lotus Notes so it's been difficult to debug by sending emails and screen shots back and forth

The test macro to simulate the real attachment runs OK (the easy part), and the Send Email macro seems to run, but there is no email message generated and sent.

Hoping someone with Lotus Notes experience (and even better access to Notes) can let me know what I have to do

Option Explicit

Const sYourEmail As String = "YourEmail@Somewhere.com"  '   see if you can send to yourself

Sub TestMail()
    Dim wbEmail As Workbook
    Dim sFilename As String, sName As String
    
    'simulate making the real workbook to be attached
    'init
    sName = Application.UserName
    sFilename = ThisWorkbook.Path & Application.PathSeparator & sName & ".xlsx"

    'delete file if it exists
    On Error Resume Next
    Application.DisplayAlerts = False
    Kill sFilename
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    'create attachment workbook -- JUST A TEST
    Application.ScreenUpdating = False
    ThisWorkbook.Worksheets("Sheet2").Copy
    Set wbEmail = ActiveWorkbook
    ThisWorkbook.Worksheets("Sheet3").Copy after:=wbEmail.Worksheets(wbEmail.Worksheets.Count)
    ThisWorkbook.Worksheets("Sheet4").Copy after:=wbEmail.Worksheets(wbEmail.Worksheets.Count)
    ThisWorkbook.Worksheets("Sheet5").Copy after:=wbEmail.Worksheets(wbEmail.Worksheets.Count)
    wbEmail.SaveAs Filename:=sFilename, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    wbEmail.Close
    Application.ScreenUpdating = True
    Stop
    
    'This is the part where i can't test - see if you can send email to yourself
    Call SendNotesMail("Update (" & Format(Now, "yyyy-mm-dd") & ")", sFilename, sYourEmail, "Please Review")

End Sub

Option Explicit

'https://www.mrexcel.com/forum/excel-questions/959083-vba-script-send-mail-through-lotus-notes.html

Sub SendNotesMail(Subject As String, Attachment As String, Recipient As String, BodyText As String)
    
    Const EMBED_ATTACHMENT As Long = 1454
    Const RICHTEXT As Long = 1

    Dim notesSession As Object
    Dim notesDatabase As Object
    Dim notesDocument As Object
    Dim notesEmbedObject As Object
    Dim notesAttachment As Object

    Stop

    'Instantiate the Lotus Notes COM's Objects.  ---- This is where it fails for me since I don't have Lotus Notes
    Set notesSession = CreateObject("Notes.NotesSession")
    Set notesDatabase = notesSession.GETDATABASE("", "")

    'If Lotus Notes is not open then open the mail-part of it.
    If notesDatabase.IsOpen = False Then notesDatabase.OPENMAIL

    'Create the e-mail and the attachment.
    Set notesDocument = notesDatabase.CREATEDOCUMENT
    Set notesAttachment = notesDocument.CREATERICHTEXTITEM(Attachment)

'    Set notesEmbedObject = notesAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
    'Add values to the created e-mail main properties.
    With notesDocument
        .Form = "Memo"
        .sendto = Recipient
        .Subject = Subject
        .Body = BodyText
        .SAVEMESSAGEONSEND = True
        .PostedDate = Now()
        .SEND 0, Recipient
    End With

    'Release objects from memory.
    Set notesEmbedObject = Nothing
    Set notesAttachment = Nothing
    Set notesDocument = Nothing
    Set notesDatabase = Nothing
    Set notesSession = Nothing
    MsgBox "The e-mail has successfully been created and distributed", vbInformation
End Sub