vba - send email to lotus notes via excel

[george hart]

Hi

I need code that sends an e-mail to a specific person (lotus notes) if range "A1" = Overdue.

The email address of the person needing the email will be in cell "B1" and so on B2, B3 Etc if the cell next to it in column A reads overdure.

The code below captures my range but not how to send the messge to the recipient...Any ideas most welcome.

Dim x As Integer
For x = 3 To Cells(Rows.Count, "A").End(xlUp).Row

If Range("A" & x) = "Overdue" Then _
'I need the code to go here to send a messege that reads, "Please esnure you update your files etc...

Next
End Sub

Many thanks in advance...

 

[John Davis]

Hi

I need code that sends an e-mail to a specific person (lotus notes) if range "A1" = Overdue.

The email address of the person needing the email will be in cell "B1" and so on B2, B3 Etc if the cell next to it in column A reads overdure.

The code below captures my range but not how to send the messge to the recipient...Any ideas most welcome.

Dim x As Integer
For x = 3 To Cells(Rows.Count, "A").End(xlUp).Row

If Range("A" & x) = "Overdue" Then _
'I need the code to go here to send a messege that reads, "Please esnure you update your files etc...

Next
End Sub

Many thanks in advance...

Untested but perhaps here's something you can tinker with.

Sub GeorgeHart()

Dim x As Integer
Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim stSignature As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False

' Open and locate current LOTUS NOTES User

For x = 3 To Cells(Rows.Count, "A").End(xlUp).Row

If Range("A" & x) = "Overdue" Then

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 = "Range(""B""&x).value"
MailDoc.SendTo = Recipient
MailDoc.Subject = "URGENT NOTIFICATION"
MailDoc.Body = "Please ensure you update your files." & vbCrLf & vbCrLf & stSignature

MailDoc.SaveMessageOnSend = True

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

Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing

.ScreenUpdating = True
.DisplayAlerts = True
End With

errorhandler1:

Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing

End If

Next x

End Sub

 

[george hart]

Many, many thanks...I changed the code slightly (as below highlighted in bold) and it works a treat. Thanks again and very much appreciated...

Dim x As Integer
Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim stSignature As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' Open and locate current LOTUS NOTES User
For x = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Range("A" & x) = "Overdue" Then
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 = Worksheets("Sheet1").Range("B" & x).Value
MailDoc.SendTo = Recipient
MailDoc.Subject = "URGENT NOTIFICATION"
MailDoc.Body = "Please ensure you update your files." & vbCrLf & vbCrLf & stSignature
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
.ScreenUpdating = True
.DisplayAlerts = True

errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
End If
Next x
End With
End Sub

 

[John Davis]

Many, many thanks...I changed the code slightly (as below highlighted in bold) and it works a treat. Thanks again and very much appreciated...

Dim x As Integer
Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim stSignature As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' Open and locate current LOTUS NOTES User
For x = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Range("A" & x) = "Overdue" Then
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 = Worksheets("Sheet1").Range("B" & x).Value
MailDoc.SendTo = Recipient
MailDoc.Subject = "URGENT NOTIFICATION"
MailDoc.Body = "Please ensure you update your files." & vbCrLf & vbCrLf & stSignature
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
.ScreenUpdating = True
.DisplayAlerts = True

errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
End If
Next x
End With
End Sub

You're welcome. Glad it worked for you.

 

[JJerram11]

Hi i have been searching the net and came across this site. I want to setup my xcel spreadsheet to send and email soon as my stock counds turns to order. I have got a formula in place to tell me when it need to be ordered. which is =IF(D440>=E440,"Stock Ok","OrderStock") how can i then set up a macros or vba to send an email to a person to say please order stock? i no nothing about writing a macros so any help would be appreciated

 

[John Davis]

Hi i have been searching the net and came across this site. I want to setup my xcel spreadsheet to send and email soon as my stock counds turns to order. I have got a formula in place to tell me when it need to be ordered. which is =IF(D440>=E440,"Stock Ok","OrderStock") how can i then set up a macros or vba to send an email to a person to say please order stock? i no nothing about writing a macros so any help would be appreciated

I'm using excel 2003, and Lotus Notes. If you have the same then you could got to Tools>Macro>Visual Basic Editor>Select the Project on the Left side pane>From the Menus choose Insert>Module>then copy the code below and paste. You can then test it from the VBE window by choosing Run of from the Excel Window Tools>Macro>Select>Run. Note the arrows is where you edit and put your recipient, subject, and body information.


This may get you started:

Sub JJerram11()

Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim stSignature As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With



If Range("D440") < Range("E440") Then

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 = "PLACE YOUR ADDEES HERE" '<------------
MailDoc.SendTo = Recipient
MailDoc.Subject = "STOCK REQUISITION REQUIRED" '<---------------
MailDoc.Body = "Your inventory is low, please order your stocks today." & vbCrLf & vbCrLf & stSignature

MailDoc.SaveMessageOnSend = True

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

Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing

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

errorhandler1:

Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing

End If


End Sub

 

[JJerram11]

Thanks for the reply, unforntuanlty i cant seem to get it to work, am using excel 2007 not 2003 with lotus notes 8, i copied and pasted everything into the visual editor and inputed my email adress where the arrows were pointing, but nothing happens?? am i doing something wrong? also i have 700 different locations in this spreadsheet, how do i do it so it looks at every locations to send the email, do i have to do it 700 different times??

 

[Dmmnn]

Hi guys,

I came across this forum/topic as well, tried your script, made a few minor adjustments but basically it works as a charm! (I'm using MS Excel 2007) and latest version of notes so no issues here btw, thanks for this script .
This is how I used it:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
Dim x As Integer
Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim stSignature As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' Open and locate current LOTUS NOTES User
'For x = 2 To Cells(Rows.Count, "A").End(xlUp).Row
'If Range("A" & x) = "Overdue" Then
Set Session = CreateObject("Notes.NotesSession")
Set WatchRange = Range("B2:H15")
Set IntersectRange = Intersect(Target, WatchRange)
If IntersectRange Is Nothing Then
'Cells(1, 1).Value = Cells(1, 1).Value
Else
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 = "Message"
'stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
' Select range of e-mail addresses
'Recipient = Worksheets("Sheet1").Range("B" & x).Value
MailDoc.SendTo = "myemail@mailserver.com"
MailDoc.Subject = "Document content-change notification"
MailDoc.Body = "I changed document content. Please be informed."
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
End If
End With
End Sub

OK, as you can see above, I detect all changes within the range B2 and H15 (area) and send notification for each cell content change.

I now want different purpose to this notification. I'm posting here because it relates on how the notification is processed/sent.


Here's the functionality I would like to implement:

Instead of sending notification each time a cell content changes, I want to gather (quietly) all changes and store them in an array variable or something similar and when the document is saved, I should check that variable (with a final if) and if the var is empty do nothing, else send notification in which to display all the changes in a somewhat organized manner (before and after the change; only the strings, not their cell location)

I tried my Picasso skills in the pic above.

Hope I made my intention clear enough, if not please don't hesitate to ask for more details.

Many thanks!

 

[Dmmnn]

Anyone? Help? Will very much appreciate it! :D

 

[TheCman81]

I to was looking for a piece of code to send an email through lotus notes and came across this, it works fine but I want to know how to attached the workbook using this code?

Thanks

Sub GeorgeHart()
Dim x As Integer
Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session 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 = "[EMAIL="uk-sales-opde@heineken.co.uk"]email address[/EMAIL]"
MailDoc.SendTo = Recipient
MailDoc.Subject = "Test"
MailDoc.Body = ""
MailDoc.SaveMessageOnSend = True
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set Session = Nothing
End Sub