Create Email but don't Send - Lotus Notes

[Sean Stevens]

I have the following code which creates an email and sends it. Works fine.

However, I was wondering if it was possible for the email to be created and not sent. This will give the user the oppertunity to enter some comments into the body of the email. I know I can do this through the use of an inputbox, but I really want them to enter the comments via their email client.

Sub EmailFile ()
' Declare Variables for file and macro setup

Dim UserName As String
Dim MailDbName As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj1 As Object

' Open and locate current LOTUS NOTES User

Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If

' Create New Mail and Address Title Handlers

Set MailDoc = Maildb.CreateDocument

MailDoc.Form = "Memo"
MailDoc.SendTo = "email@web.com"


MailDoc.Subject = "BEN New Project"
MailDoc.Body = _
"Attached is a new BEN Project Request. Please let me know when it has been setup."

' Select Workbook to Attach to E-Mail

MailDoc.SaveMessageOnSend = False
attachment1 = "C:\Temp\New BEN Project.xls" ' Required File Name

If attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", "C:\Temp\New BEN Project.xls", "") 'Required File Name
On Error Resume Next
End If

MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.Send 0, Recipient

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing

errorhandler1:

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing

With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With

End Sub

Thanks, Sean.

 

[Andrada]

I have searched quite some hours on how to attach to an email a freely selected range, just the current selection, a range of filtered information, so I might as well share this with you guys.

Sub LotusNotsSendActiveSheet()
Dim objNotesSession As Object
Dim objNotesMailFile As Object
Dim objNotesDocument As Object
Dim objNotesRngMyRange As Range
Dim objNotesField As Object
On Error GoTo SendMailError
EmailSendto = Recipient
EMailCCTo = "" '' Optional
EMailBCCTo = "" '' Optional
EmailSubject = "Parts Price Quote"
''Establish Connection to Notes
Set objNotesSession = CreateObject("Notes.NotesSession")
''Establish Connection to Mail File
'' .GETDATABASE("SERVER", "FILE")
Set objNotesMailFile = objNotesSession.GETDATABASE("", "")
''Open Mail
objNotesMailFile.OPENMAIL
''Create New Memo
Set objNotesDocument = objNotesMailFile.CREATEDOCUMENT
''Create 'Subject Field'
Set objNotesField = objNotesDocument.APPENDITEMVALUE("Subject", EmailSubject)
''Create 'Send To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("SendTo", EmailSendto)
''Create 'Copy To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("CopyTo", EMailCCTo)
''Create 'Blind Copy To' Field
Set objNotesField = objNotesDocument.APPENDITEMVALUE("BlindCopyTo", EMailBCCTo)
''Create 'Body' of memo
Set objNotesField = objNotesDocument.CREATERICHTEXTITEM("Body")
With objNotesField
.APPENDTEXT "This e-mail is generated by an automated process."
.ADDNEWLINE 1
.APPENDTEXT "Please follow established contact procedures should you have any questions."
.ADDNEWLINE 2

Set objNotesSession = CreateObject("Notes.NotesUIWorkspace")
Set objNotesDocument = objNotesSession.editdocument(True, objNotesDocument, False)
Call objNotesDocument.GoToField("Body")
ActiveSheet.Select
ActiveSheet.Range("Table_IM_Management.accdb35[#Headers],Table_IM_Management.accdb35").Copy 'To add header and filtered values
Call objNotesDocument.Paste

End With


''Release storage
Set objNotesSession = Nothing
Set objNotesSession = Nothing
Set objNotesMailFile = Nothing
Set objNotesDocument = Nothing
Set objNotesField = Nothing
''Set return code
SendMail = True
Exit Sub
SendMailError:
Msg = "Error # " & str(err.Number) & " was generated by " _
& err.Source & Chr(13) & err.Description
MsgBox Msg, , "Error", err.HelpFile, err.HelpContext
SendMail = False
End Sub