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

[Paul_Hossler]

Updated the send macro



Option Explicit

'https://www.rondebruin.nl/win/s1/notes/notes4.htm
Sub SendWithLotus(Subject As String, Attachment As String, Recipient As String, BodyText As String)
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object

Const EMBED_ATTACHMENT As Long = 1454



'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")

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

'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument

'http://www.fabalou.com/VBandVBA/lotusnotesmail.asp
'Point of note. Certain versions of 4.x client handle differently.
'If you get an error on the line MailDoc.CREATERICHTEXTITEM ("Attachment"), then
'try removing that line. In later versions of notes API this task is carried out by the
'previous line. Earlier versions required the call afterwards

'if it doesn't work comment out this line
'--------------------------------------------------------------------------------------------


'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = Recipient
.Subject = Subject
.Body = BodyText
.SaveMessageOnSend = True
End With

'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, Recipient
End With

'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing


MsgBox "The e-mail has successfully been created and distributed.", vbInformation

End Sub

[Kenneth Hobs]

Last time I used Lotus Notes was probably 2011 so I can't really look into it much. I most always had Lotus Notes open so I set the object using the user's NSF filename. Change the khobson to fit the user. They can do a Window's Explore to find it or look in their Lotus Note's folder and Mail subfolder. If they right click their Lotus Notes icon, I think they can find the NSF filename that way too.

e.g.

'************** ADD YOUR username.
Set Maildb = Session.GETDATABASE("", "mail\khobson.nsf")
If Maildb.IsOpen = False Then Maildb.OPENMAIL


The other test you can do is to ask them to close Lotus Notes and then run the macro. That should then trigger the OpenMail option. I think it will wait for the logon to continue the macro. The better option though is have Lotus Notes open prior to running the VBA macro.

If this does not help, post back and I will review some of my 2011 code examples. I suspect that you found most of my posts though.

[Paul_Hossler]

Thanks

It seems that the message goes through, but without the attachment

What I got back from the user is ...



Unfortunately, still no attachment. The Point of Fail Is:
(Dot)send 0, Recipient
It gives the fail message, but still sends the email minus attachment.

[Kenneth Hobs]

I would suggest checking if the file exists before setting the 2 objects:

'Add values to the created e-mail main properties. With noDocument
.Form = "Memo"
.SendTo = Recipient
.Subject = Subject
.Body = BodyText
Set obAttachment = noDocument.CreateRichTextItem("Attachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", Attachment)
.SaveMessageOnSend = True
End With

It was mostly there in post #1 but the 2nd object was commented out and the variable name was stAttachment as Ron used but your input variable was Attachment.

[Paul_Hossler]

1. The commented out line ...






'Set notesEmbedObject = notesAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)




… was because of a note I found




'http://www.fabalou.com/VBandVBA/lotusnotesmail.asp
'Point of note. Certain versions of 4.x client handle differently.
'If you get an error on the line MailDoc.CREATERICHTEXTITEM ("Attachment"), then
'try removing that line. In later versions of notes API this task is carried out by the
'previous line. Earlier versions required the call afterwards

'if it doesn't work comment out this line
'--------------------------------------------------------------------------------------------



2. The driver sub creates the test workbook so the
SendWithLotus should always find it

3. The latest grope in the dark ….




Option Explicit

'https://www.rondebruin.nl/win/s1/notes/notes4.htm

Sub SendWithLotusNew(Subject As String, Attachment As String, Recipient As String, BodyText As String)
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object

Const EMBED_ATTACHMENT As Long = 1454

'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")

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

'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set obAttachment = noDocument.CreateRichTextItem("Attachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", Attachment)

'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = Recipient
.Subject = Subject
.Body = BodyText
.SaveMessageOnSend = True
End With

'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, Recipient
End With

'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

End Sub





Still no joy :crying:

[Kenneth Hobs]

Could be a file creation timing issue?

After the Dim lines, I would check for it anyway. Normally, one might just do the Set for Attachment object if the file did exist. In this case, I would use this method though as a debug tool.


If Dir(Attachment) = "" Then
MsgBox Attachment, vbCritical, "File Does Not Exist - Macro Ending!"
Exit Sub
End If

[Paul_Hossler]

That's a good thought, but single stepping through the calling sub I can see the test attachment WB being created and saved

Tracing into the email sub, I can see that all calling parameters are correct.

On my PC I can only get to the Create.Object since I don't have Notes :(







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
'This is the part where i can't test - see if you can send email to yourself
Call SendWithLotusNew("Test email v6 (Sept22) version", sFilename, sYourEmail, "Test email v6 (Sept22) version")
End Sub






I keep coming back to thinking that there's something about the 3 bold lines that I'm missing





'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set obAttachment = noDocument.CreateRichTextItem("Attachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", Attachment)

'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = Recipient
.Subject = Subject
.Body = BodyText
.SaveMessageOnSend = True
End With

'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, Recipient
End With

[Kenneth Hobs]

I don't see a problem there.

Did you look at this approach? It is sort of similar to the Outlook WordEditor method that allows pasting into the body. You can remove that part. I don't remember if I used this method.


'http://www.experts-exchange.com/Applications/Email/Lotus_Notes_Domino/Q_21829026.html
Public Function SendEmail(SendTo As String, EmailSubject As String, MyAttachment As String) As Boolean
SendEmail = True
Dim myRange As Range 'I set a range on the spreadsheet
Const EMBED_ATTACHMENT As Integer = 1454
Const EMBED_OBJECT As Integer = 1453
Const EMBED_OBJECTLINK As Integer = 1452

Worksheets("Sheet1").Activate
Worksheets("Sheet1").Range("Range1").Select
Worksheets("Sheet1").Range("Range1").Copy


On Error GoTo ErrorMsg

Dim EmailList As Variant
Dim ws, uidoc, session, db, uidb, NotesAttach, NotesDoc, objShell As Object
Dim RichTextBody, RichTextAttachment As Object
Dim server, mailfile, user, usersig As String
Dim SubjectTxt, MsgTxt As String

Set session = CreateObject("Notes.NotesSession")
If session Is Nothing Then
MsgBox "Sorry, unable to instantiate the Notes Session", vbOKOnly, "Unable to Continue"
SendEmail = False
Exit Function
End If

user = session.UserName
usersig = session.CommonUserName
server = ""
'server = session.GetEnvironmentString("MailServer", True)
mailfile = session.GetEnvironmentString("MailFile", True)

Set db = session.GetDatabase(server, mailfile)
If Not db.IsOpen Then
Call db.Open("", "")
End If

If Not db.IsOpen Then
MsgBox "Sorry, unable to open: " & mailfile, vbOK, "Unable to Continue"
SendEmail = False
Exit Function
End If
Set NotesDoc = db.createdocument
With NotesDoc
.form = "Memo"
.Principal = user
.Subject = EmailSubject 'The subject line in the email
.SendTo = SendTo 'temp variant for now
End With
Set RichTextBody = NotesDoc.CreateRichTextItem("Body")
If Not RichTextBody Is Nothing Then
If MyAttachment <> "" Then
Call RichTextBody.addnewline(2)
Call RichTextBody.appendText("Please find the following file attached: " & MyAttachment)
Call RichTextBody.addnewline(1)
Call RichTextBody.EmbedObject(EMBED_ATTACHMENT, "", MyAttachment)
Call RichTextBody.addnewline(1)
Else
Call RichTextBody.addnewline(2)
Call RichTextBody.appendText("There were no excel files to attach to this notice")
Call RichTextBody.addnewline(1)
End If
End If

With NotesDoc
.computewithform False, False
.savemessageonsend = True
.Save True, False, True
End With

'Now set the front end stuff
Set ws = CreateObject("Notes.NotesUIWorkspace")
If Not ws Is Nothing Then
Set uidoc = ws.editdocument(True, NotesDoc)
If Not uidoc Is Nothing Then
If uidoc.editmode Then
Call uidoc.gotofield("Body")
Call uidoc.Paste
End If
End If
End If

With NotesDoc
.postedDate = Date
.Save True, False, True
.SaveOptions = "0"
.Send False
End With

Set session = Nothing 'close connection to free memory
Set db = Nothing
Set NotesAttach = Nothing
Set NotesDoc = Nothing
Set uidoc = Nothing
Set ws = Nothing

Exit Function


ErrorMsg:
On Error GoTo 0
SendEmail = False
MsgBox "Sorry there was an error processing the request: " + Error$ + "-" + Str(Err), vbOKOnly, "Error"
Set session = Nothing 'close connection to free memory
Set db = Nothing
Set NotesAttach = Nothing
Set NotesDoc = Nothing
Set ws = Nothing
Exit Function
End Function

[Paul_Hossler]

Feedback from the user is that this version works -- sends an email with the attachment

Sometimes their email seemed to be slow and an email sent to themselves would take 90+ minutes to show up




Option Explicit
'https://www.rondebruin.nl/win/s1/notes/notes4.htm
Sub SendWithLotus(Subject As String, Attachment As String, Recipient As String, BodyText As String)
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim obAttachment As Object, EmbedObject As Object

Const EMBED_ATTACHMENT As Long = 1454

'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")

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

'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set obAttachment = noDocument.CreateRichTextItem("Attachment")
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", Attachment)

'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = Recipient
.Subject = Subject
.Body = BodyText
.SaveMessageOnSend = True
End With

'Send the e-mail.
With noDocument
.PostedDate = Now()
.Send 0, Recipient
End With

'Release objects from the memory.
Set EmbedObject = Nothing
Set obAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

End Sub