ROBJ
12-20-2017, 06:45 PM
Good Day All
The below code sends the active workbook & a printscreen of the current sheet via Lotus Notes. It works perfectly, but I need to distribute to a number of recipients that change from time to time. So I added a "Helper" tab to the workbook, to explain various functions to the end user and include the array of Lotus Notes recipients. I've adapted the code & changed from string to variant for recipients:
Dim vaRecipients As Variant
Dim vaCopyTo As Variant
Dim myArr As Variant
Dim emailto As Variant
'Create the list of recipients.
Set EmailTo = Worksheets("Helper").Range("L13")
Set myArr = Worksheets("Helper").Range("L15:L100")
vaRecipients = EmailTo
vaCopyTo = myArr
but I am getting a runtime error 13 Type mismatch when it arrives to
With NUIDocument
.FieldSetText "EnterSendTo", EmailTo.
Any ideas on how to fix this are greatly appreciate it.
Thank you for your insight.
Fully working code with recipients defined as string :
Public Sub Send_Lotus_Email()
Const EMBED_ATTACHMENT = 1454
Dim NSession As Object
Dim NWorkspace As Object
Dim NMailDb As Object
Dim NUIDocument As Object
Dim NRTattachment As Object
Dim Subject As String
Dim SendTo As String, CopyTo As String
Dim attachmentFile As String
Dim embedCells As Range
Dim CurrentFile As String
Dim lnRetVal As Long
'Check if Lotus Notes is open or not.
lnRetVal = FindWindow("NOTES", vbNullString)
If lnRetVal = 0 Then
MsgBox "Please make sure that Lotus Notes is open!", vbExclamation
Exit Sub
End If
If MsgBox("Are you sending the report?", _
vbOKCancel) = vbCancel Then Exit Sub
'------------ User-defined settings section ------------
SendTo = "yyyyy"
'CopyTo = "***xx"
'Subject = "REPORT" - changed to WB's name... dependant
CurrentFile = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))
Subject = CurrentFile
'Subject = ActiveWorkbook.Name - changed to above code to avoid showing file extension
'The cells to be embedded in the email body
Set embedCells = ActiveSheet.Range("A1:M73")
'Optional file attachment - full folder path and file name, or "" for no attachment
'attachmentFile = "C:\path\to\file.xls" - changed for WB full name below
attachmentFile = ActiveWorkbook.FullName
'attachmentFile = "" - needed if no attachment is bein sent
'------------ End of user-defined settings ------------
Set NSession = CreateObject("Notes.NotesSession") 'OLE, late binding only
Set NWorkspace = CreateObject("Notes.NotesUIWorkspace")
Set NMailDb = NSession.GetDatabase("", "")
NMailDb.OpenMail
NWorkspace.ComposeDocument , , "Memo"
Set NUIDocument = NWorkspace.CurrentDocument
With NUIDocument
.FieldSetText "EnterSendTo", SendTo
.FieldSetText "EnterCopyTo", CopyTo
.FieldSetText "EnterBlindCopyTo", ""
.FieldSetText "Subject", Subject
.GotoField "Body"
'------------ Start of email body text ------------
.InsertText "Please see attached report."
'Copy and paste Excel cells as a bitmap image into the email body
.InsertText vbLf & vbLf & "Synopsis:" & vbLf & vbLf
embedCells.CopyPicture , xlBitmap
.Paste
Application.CutCopyMode = False
.InsertText vbLf & vbLf & "Kind regards." & vbLf & vbLf
'------------ End of email body text ------------
'Optional file attachment
If attachmentFile <> "" Then
Set NRTattachment = .Document.CreateRichTextItem("Attachment")
NRTattachment.EmbedObject EMBED_ATTACHMENT, "", attachmentFile
End If
.Save
.Close
End With
'Send S key to click the 'Send and Save' button to send mail document
Application.Wait DateAdd("s", 2, Now)
AppActivate "Send Mail", True
SendKeys "S"
Set NUIDocument = Nothing
Set NWorkspace = Nothing
Set NMailDb = Nothing
Set NSession = Nothing
MsgBox "The e-mail has successfully been created and distributed", vbInformation
End Sub
The below code sends the active workbook & a printscreen of the current sheet via Lotus Notes. It works perfectly, but I need to distribute to a number of recipients that change from time to time. So I added a "Helper" tab to the workbook, to explain various functions to the end user and include the array of Lotus Notes recipients. I've adapted the code & changed from string to variant for recipients:
Dim vaRecipients As Variant
Dim vaCopyTo As Variant
Dim myArr As Variant
Dim emailto As Variant
'Create the list of recipients.
Set EmailTo = Worksheets("Helper").Range("L13")
Set myArr = Worksheets("Helper").Range("L15:L100")
vaRecipients = EmailTo
vaCopyTo = myArr
but I am getting a runtime error 13 Type mismatch when it arrives to
With NUIDocument
.FieldSetText "EnterSendTo", EmailTo.
Any ideas on how to fix this are greatly appreciate it.
Thank you for your insight.
Fully working code with recipients defined as string :
Public Sub Send_Lotus_Email()
Const EMBED_ATTACHMENT = 1454
Dim NSession As Object
Dim NWorkspace As Object
Dim NMailDb As Object
Dim NUIDocument As Object
Dim NRTattachment As Object
Dim Subject As String
Dim SendTo As String, CopyTo As String
Dim attachmentFile As String
Dim embedCells As Range
Dim CurrentFile As String
Dim lnRetVal As Long
'Check if Lotus Notes is open or not.
lnRetVal = FindWindow("NOTES", vbNullString)
If lnRetVal = 0 Then
MsgBox "Please make sure that Lotus Notes is open!", vbExclamation
Exit Sub
End If
If MsgBox("Are you sending the report?", _
vbOKCancel) = vbCancel Then Exit Sub
'------------ User-defined settings section ------------
SendTo = "yyyyy"
'CopyTo = "***xx"
'Subject = "REPORT" - changed to WB's name... dependant
CurrentFile = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))
Subject = CurrentFile
'Subject = ActiveWorkbook.Name - changed to above code to avoid showing file extension
'The cells to be embedded in the email body
Set embedCells = ActiveSheet.Range("A1:M73")
'Optional file attachment - full folder path and file name, or "" for no attachment
'attachmentFile = "C:\path\to\file.xls" - changed for WB full name below
attachmentFile = ActiveWorkbook.FullName
'attachmentFile = "" - needed if no attachment is bein sent
'------------ End of user-defined settings ------------
Set NSession = CreateObject("Notes.NotesSession") 'OLE, late binding only
Set NWorkspace = CreateObject("Notes.NotesUIWorkspace")
Set NMailDb = NSession.GetDatabase("", "")
NMailDb.OpenMail
NWorkspace.ComposeDocument , , "Memo"
Set NUIDocument = NWorkspace.CurrentDocument
With NUIDocument
.FieldSetText "EnterSendTo", SendTo
.FieldSetText "EnterCopyTo", CopyTo
.FieldSetText "EnterBlindCopyTo", ""
.FieldSetText "Subject", Subject
.GotoField "Body"
'------------ Start of email body text ------------
.InsertText "Please see attached report."
'Copy and paste Excel cells as a bitmap image into the email body
.InsertText vbLf & vbLf & "Synopsis:" & vbLf & vbLf
embedCells.CopyPicture , xlBitmap
.Paste
Application.CutCopyMode = False
.InsertText vbLf & vbLf & "Kind regards." & vbLf & vbLf
'------------ End of email body text ------------
'Optional file attachment
If attachmentFile <> "" Then
Set NRTattachment = .Document.CreateRichTextItem("Attachment")
NRTattachment.EmbedObject EMBED_ATTACHMENT, "", attachmentFile
End If
.Save
.Close
End With
'Send S key to click the 'Send and Save' button to send mail document
Application.Wait DateAdd("s", 2, Now)
AppActivate "Send Mail", True
SendKeys "S"
Set NUIDocument = Nothing
Set NWorkspace = Nothing
Set NMailDb = Nothing
Set NSession = Nothing
MsgBox "The e-mail has successfully been created and distributed", vbInformation
End Sub