Public Sub Send_Notes_Email()
'Requires reference to Lotus Domino Objects (domobj.tlb) for constants such as EMBED_ATTACHMENT and FONT_HELV, etc.
'Code based on answer by Bill-Hanson:
'http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/Lotus_SmartSuite/Lotus_Notes/Q_22733557.html#a19616928
Dim NSession As Object
Dim NUIWorkspace As Object
Dim NMailDb As Object
Dim NDocumentTemp As Object
Dim NUIDocumentTemp As Object
Dim NUIDocument As Object
Dim NRTItemBody As Object
Dim NRTStyle As Object, NRTStyleDefault As Object
Dim NRTItemAttachment As Object, embeddedAttachment As Object
Dim Subject As String
Dim SendTo As String, CopyTo As String, BlindCopyTo As String
Dim fileAttachment As String
Dim embedCells As Range
Dim FSO As Object
Dim tempFolder As String, tempCellsJPG As String
Dim Copy_and_Paste As Boolean
'--------- EDIT USER-DEFINED SETTINGS IN THIS SECTION ---------
'The Excel cells to be included in the email body as an image
Set embedCells = ActiveSheet.Range("A1:C8")
'The file to be attached to the email, if it exists
fileAttachment = "C:\folder1\folder2\file.txt"
SendTo = "email1@email.com,email2@email.com"
CopyTo = "email2@email.com"
BlindCopyTo = ""
Subject = "Email subject"
'--------- END OF USER-DEFINED SETTINGS ---------
'Copy_and_Paste flag
'True = copy and paste Excel cells into email body using the clipboard
'False = save Excel cells as a temporary .jpg file and import into email body
Copy_and_Paste = True
Set FSO = CreateObject("Scripting.FileSystemObject")
tempFolder = FSO.GetSpecialFolder(2)
'File name for temporary .jpg file containing Excel cells
tempCellsJPG = tempFolder & "\" & Replace(FSO.GetTempName(), ".tmp", ".jpg")
Set NSession = CreateObject("Notes.NotesSession") 'OLE (late binding only) because we access Notes UI classes
Set NUIWorkspace = CreateObject("Notes.NotesUIWorkspace")
Set NMailDb = NSession.GetDatabase("", "")
NMailDb.OpenMail
'Create the default rich text style
Set NRTStyleDefault = NSession.CreateRichTextStyle
With NRTStyleDefault
.NotesColor = COLOR_BLACK
.FontSize = 10
.NotesFont = FONT_HELV
.Bold = False
.Italic = False
End With
Set NRTStyle = NSession.CreateRichTextStyle
'Create a temporary NotesDocument
Set NDocumentTemp = NMailDb.CreateDocument
With NDocumentTemp
.Form = "Memo"
'Add a rich text item to contain the email body text and file attachment
Set NRTItemBody = .CreateRichTextItem("Body")
With NRTItemBody
'--------- ADD/EDIT CODE IN THIS SECTION FOR THE EMAIL BODY TEXT ---------
'Compose the email body text
.AppendText "1st paragraph - default font."
.AddNewLine 2
With NRTStyle
.NotesFont = FONT_ROMAN
.FontSize = 14
.NotesColor = COLOR_BLUE
.Bold = True
End With
.AppendStyle NRTStyle
.AppendText "2nd paragraph - Times New Roman Blue 14 Bold"
.AddNewLine 2
'Add placeholder text which will be replaced by the Excel cells
.AppendText "{PLACEHOLDER}"
.AddNewLine 2
With NRTStyle
.NotesFont = FONT_HELV
.FontSize = 10
.NotesColor = COLOR_RED
.Italic = True
End With
.AppendStyle NRTStyle
.AppendText "3rd paragraph - Helvetica Red 10 italic."
'Same paragraph, default style
.AppendStyle NRTStyleDefault
.AppendText " Excel cells are shown above."
If fileAttachment <> "" Then
.AddNewLine 2
.AppendText fileAttachment & " attached"
.AddNewLine 1
.EmbedObject EMBED_ATTACHMENT, "", fileAttachment
.AddNewLine 1
End If
'--------- END OF EMAIL BODY TEXT SECTION --------
End With
.Save False, False
End With
'Display the temporary document in the UI
Set NUIDocumentTemp = NUIWorkspace.EditDocument(True, NDocumentTemp)
'Copy the rich text to the clipboard, close the window, and delete the temp doc
With NUIDocumentTemp
.gotofield "Body"
.SelectAll
.Copy
'The next 2 lines are not needed
'.Document.SaveOptions = "0" 'prevent prompt
'.Document.MailOptions = "0" 'prevent prompt
.Close 'therefore temp UI doc not saved
End With
NDocumentTemp.Remove True
'Compose the real email document
Set NUIDocument = NUIWorkspace.ComposeDocument(NMailDb.Server, NMailDb.filePath, "Memo")
'Set NUIDocument = NUIWorkspace.ComposeDocument(, , "Memo") 'use local computer and current database
With NUIDocument
.FieldSetText "EnterSendTo", SendTo
.FieldSetText "EnterCopyTo", CopyTo
.FieldSetText "BlindCopyTo", BlindCopyTo
.FieldSetText "Subject", Subject
'The memo now has everything except the rich text from the temporary UI document and the Excel cells image.
'The automatic signature (if defined in User Preferences) should be at the bottom of the memo. Now, we just
'paste the rich text and Excel cells into the body
.gotofield "Body"
.Paste
'Replace the placeholder text with the Excel cells image
.gotofield "Body"
.FindString "{PLACEHOLDER}"
'.DESELECTALL 'Uncomment to leave the placeholder text in place (cells are inserted immediately before it)
If Copy_and_Paste Then
embedCells.CopyPicture xlBitmap
.Paste
Application.CutCopyMode = False
Else
Save_Object_As_JPG embedCells, tempCellsJPG
.Import "JPEG Image", tempCellsJPG
Kill tempCellsJPG
End If
'Set NotesDocument options to save and send the email without prompts when the Close method is called
.Document.SaveOptions = "1"
.Document.MailOptions = "1"
.Close
End With
End Sub
'Based on http://www.jpsoftwaretech.com/export-excel-range-to-a-picture-file/
Private Sub Save_Object_As_JPG(saveObject As Object, JPGfileName As String)
'Save a picture of an object as a JPG/JPEG file
'Arguments
'saveObject - any object in the CopyPicture method's 'Applies To' list, for example a Range or Shape
'JPGfileName - the file name (including folder path if required) to save the picture as
Dim temporaryChart As ChartObject
Application.ScreenUpdating = False
saveObject.CopyPicture xlScreen, xlPicture
Set temporaryChart = ActiveSheet.ChartObjects.Add(0, 0, saveObject.Width, saveObject.Height)
With temporaryChart
.Border.LineStyle = xlLineStyleNone 'No border
.Chart.Paste
.Chart.Export JPGfileName
.Delete
End With
Application.ScreenUpdating = True
Set temporaryChart = Nothing
End Sub
