Sub Vanessa()
Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
'Dim Attachment1 As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
'Dim EmbedObj1 As Object
Dim stSignature As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' 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"
stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
' Select range of e-mail addresses
Recipient = Array("Recipient.One@AOL.com", "Recipient.Two@AOL.com", "Recipient.Three@AOL.com", "Recipient.Four@AOL.com", "Recipient.Five@AOL.com")
MailDoc.SendTo = Recipient
MailDoc.Subject = "PLACE YOUR SUBJECT HERE"
MailDoc.Body = "PLACE THE MESSAGE YOU WANT TO SEND HERE" & vbCrLf & vbCrLf & stSignature
' Select Workbook to Attach to E-Mail
MailDoc.SaveMessageOnSend = True
'Attachment1 = "D:\Common\data\......xls" '"C:\YourFile.xls" ' Required File Name
'If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
'Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", "D:\Common\data\......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
.ScreenUpdating = True
.DisplayAlerts = True
End With
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Target.Parent.Range("A88")
If Target.Count > 1 Then Exit Sub
If Intersect(Target, rng) Is Nothing Then Exit Sub
Call Vanessa
End SubPrivate Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Target.Parent.Range("A1")
If Target.Count > 1 Then Exit Sub
If Intersect(Target, rng) Is Nothing Then Call charlesrheaultok
End Sub
Sub charlesrheaultok()
' setting up various objects
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim attachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
Dim recipient As String
Dim ccRecipient As String
Dim bccRecipient As String
Dim subject As String
Dim bodytext As String
Dim Attachment1 As String
Dim User As String
User = Application.UserName
' setting up all sending recipients
recipient = "eployee1@aero.bombardier.com"
'ccRecipient =Someoneelse@Somewhereelse.com
'bccRecipient = ""
subject = "Reminder"
bodytext = "Reminder"
'// Make sure all info has been set before sending!
If recipient = vbNullString Or subject = vbNullString Or bodytext = vbNullString Then
MsgBox "Recipient, Subject and or Body Text is NOT SET!", vbCritical + vbInformation
Exit Sub
End If
' creating a notes session
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
On Error Resume Next
Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
' loading the lotus notes e-mail with the inputed data
With MailDoc
.SendTo = recipient
.copyto = ccRecipient
'.blindcopyto = bccRecipient
.subject = subject
.Body = bodytext
End With
' saving message (Change to True if you want to save it)
MailDoc.SaveMessageOnSend = False
Attachment1 = ThisWorkbook.Worksheets("Data").Range("B1").Value
If Attachment1 <> "" Then
Set attachME = MailDoc.CreateRichTextItem("Attachment1")
Set EmbedObj1 = attachME.EmbedObject(1454, "", Attachment1, "Attachment")
MailDoc.CreateRichTextItem ("Attachment")
End If
' send e-mail
MailDoc.PostedDate = Now()
' if error in attachment or name of recipients
On Error GoTo errorhandler1
MailDoc.Send 0, recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set attachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
'Unload Me
Exit Sub
' setting up the error message
errorhandler1:
MsgBox "Incorrect name supplied or the attachment has not been attached," & _
"or your Lotus Notes has not opened correctly. Recommend you open up Lotus Notes" & _
"to ensure the application runs correctly and that a vaild connection exists"
Set Maildb = Nothing
Set MailDoc = Nothing
Set attachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
' unloading the userform
'Unload Me
End SubSub SendMail
charlesrheaultok
End sub
