PDA

View Full Version : VBA To Send Email From Lotus Notes



dpmaki
08-23-2012, 11:54 AM
I have the following code that I'm using to send email from Lotus Notes, however the "To:" field is hardcoded. I'd like to utilize this code but send an email out to every individual found on a worksheet within this workbook. For example - worksheet is titled "Email Recipients" and in column B there are several email addresses. The list constantly changes and the number of email addresses may also change. So if there are 15 email addresses I need the same email that is generated to be sent individually to all 15 people.

Here is the code:

Sub SendEmail()

Dim Maildb As Object
Dim MailDoc As Object
Dim Body As Object
Dim Session As Object

Set sh = Sheets("Email Recipients")

Set Session = CreateObject("Lotus.NotesSession")
Call Session.Initialize("password")

Set Maildb = Session.GETDATABASE("", "C:\Program Files\IBM\Lotus\Notes\Data\mail\name.nsf")
If Not Maildb.IsOpen = True Then
Call Maildb.Open
End If

Set MailDoc = Maildb.Createdocument
Call MailDoc.ReplaceItemValue("Form", "Memo")

Call MailDoc.ReplaceItemValue("SendTo", "john.doe@email.com")


Call MailDoc.ReplaceItemValue("Subject", "Test Message From Excel VBA With Condition")

Set Body = MailDoc.CREATERICHTEXTITEM("Body")
Call Body.APPENDTEXT("This is a test message being sent to you from Excel through VBA")

Call Body.ADDNEWLINE(2)

MailDoc.SAVEMESSAGEONSEND = True

Call MailDoc.ReplaceItemValue("PostedDate", Now())
Call MailDoc.Send(False)

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

End Sub

Kenneth Hobs
08-23-2012, 01:43 PM
Create a comma delimited string. Use Join() and Split() as needed. It is simple enough. If not, post back. Once that is done:

Sub test()
Dim lErr As ErrObject
SendNotesMail _
"PMP Handbook5", _
"c:\t.pdf", _
"khobson@aodot.org,khobson@aaaahawk.com", _
"Click file: " & vbCrLf & _
"file://u:\Material\pmp\PMP%20Handbook.pdf" & vbCrLf & _
"or, open the attachement.", , lErr
If lErr.Number <> 0 Then MsgBox lErr.Number & vbCrLf & lErr.Description
End Sub

'Escape characters, %20=space, http://everything2.com/node/1350052
'Similar to: Brian Walters, http://www.ozgrid.com/forum/showthread.php?t=67089
Public Sub SendNotesMail(Subject As String, Attachment As String, _
ByVal Recipient As String, _
BodyText As String, _
Optional SaveIt As Boolean = True, _
Optional ByRef lErr As ErrObject)
'lErr is used when using the Sub in a batch process,
'to handle instances where an error appears

'Example of use:
'SendNotesMail "The Subject", "C:\My Documents\TestFile.txt", _
"john@doe.com, jane@doe.com", _
"This is the body text, can be longer", True, lErr

'Set up the objects required for Automation into lotus notes
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim ArRecipients() As String 'Array of recipients
Dim i As Long 'Counter
Dim oBody As Object 'Body of text in for rich text format

'Early Bind - Tools > Reference > Lotus Notes Automation Classes, notes32.tlb
'Dim ln As lotus.NOTESSESSION
'Set ln = CreateObject("Notes.NotesSession")
'Dim db As lotus.NOTESDATABASE
'Set db = ln.GETDATABASE("", "mail\username.nsf")
'Dim mDoc As lotus.NOTESDOCUMENT
'Set mDoc = db.CREATEDOCUMENT


'Create an array of recipients (Separated by commas)
Recipient = Recipient & ","

While InStr(1, Recipient, ",", 1) > 0
i = i + 1
ReDim Preserve ArRecipients(1 To i) As String
ArRecipients(i) = _
Left(Recipient, InStr(1, Recipient, ",", 1) - 1)
Recipient = _
Mid(Recipient, InStr(1, Recipient, ",", 1) + 1, Len(Recipient))
Wend

'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
On Error GoTo err_h

'Open the mail database in notes
UserName = Session.UserName
'************** ADD YOUR username.
Set Maildb = Session.GETDATABASE("", "mail\khobson.nsf")
If Maildb.IsOpen = False Then
Maildb.OPENMAIL
End If

'Set up the new mail document
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = ArRecipients
MailDoc.Subject = UCase(Subject)
'MailDoc.Body = UCase(BodyText)
Set oBody = MailDoc.CREATERICHTEXTITEM("Body")
oBody.APPENDTEXT BodyText

'This is supposed to be the property, but works
'on some systems only
'without an apparent reason of failure
MailDoc.SAVEMESSAGEONSEND = SaveIt

'Set up the embedded object and attachment and attach it
If Attachment <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
End If

'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
MailDoc.Send 1
MailDoc.Save True, True, False

'Clean Up
err_h:
Set lErr = Err
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub

dpmaki
09-10-2012, 11:16 AM
Hi Ken - I've been tied up over the past few weeks and am now getting back to this code you sent. I'm confused what the PMP Handbook 5 and the code in the Sub test is for. I'm not sure I'm understanding how to use this. Do I need to make some edits to the code or use as is?


Create a comma delimited string. Use Join() and Split() as needed. It is simple enough. If not, post back. Once that is done:

Sub test()
Dim lErr As ErrObject
SendNotesMail _
"PMP Handbook5", _
"c:\t.pdf", _
"khobson@aodot.org,khobson@aaaahawk.com", _
"Click file: " & vbCrLf & _
"file://u:\Material\pmp\PMP%20Handbook.pdf" & vbCrLf & _
"or, open the attachement.", , lErr
If lErr.Number <> 0 Then MsgBox lErr.Number & vbCrLf & lErr.Description
End Sub

'Escape characters, %20=space, http://everything2.com/node/1350052
'Similar to: Brian Walters, http://www.ozgrid.com/forum/showthread.php?t=67089
Public Sub SendNotesMail(Subject As String, Attachment As String, _
ByVal Recipient As String, _
BodyText As String, _
Optional SaveIt As Boolean = True, _
Optional ByRef lErr As ErrObject)
'lErr is used when using the Sub in a batch process,
'to handle instances where an error appears

'Example of use:
'SendNotesMail "The Subject", "C:\My Documents\TestFile.txt", _
"john@doe.com, jane@doe.com", _
"This is the body text, can be longer", True, lErr

'Set up the objects required for Automation into lotus notes
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim ArRecipients() As String 'Array of recipients
Dim i As Long 'Counter
Dim oBody As Object 'Body of text in for rich text format

'Early Bind - Tools > Reference > Lotus Notes Automation Classes, notes32.tlb
'Dim ln As lotus.NOTESSESSION
'Set ln = CreateObject("Notes.NotesSession")
'Dim db As lotus.NOTESDATABASE
'Set db = ln.GETDATABASE("", "mail\username.nsf")
'Dim mDoc As lotus.NOTESDOCUMENT
'Set mDoc = db.CREATEDOCUMENT


'Create an array of recipients (Separated by commas)
Recipient = Recipient & ","

While InStr(1, Recipient, ",", 1) > 0
i = i + 1
ReDim Preserve ArRecipients(1 To i) As String
ArRecipients(i) = _
Left(Recipient, InStr(1, Recipient, ",", 1) - 1)
Recipient = _
Mid(Recipient, InStr(1, Recipient, ",", 1) + 1, Len(Recipient))
Wend

'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
On Error GoTo err_h

'Open the mail database in notes
UserName = Session.UserName
'************** ADD YOUR username.
Set Maildb = Session.GETDATABASE("", "mail\khobson.nsf")
If Maildb.IsOpen = False Then
Maildb.OPENMAIL
End If

'Set up the new mail document
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = ArRecipients
MailDoc.Subject = UCase(Subject)
'MailDoc.Body = UCase(BodyText)
Set oBody = MailDoc.CREATERICHTEXTITEM("Body")
oBody.APPENDTEXT BodyText

'This is supposed to be the property, but works
'on some systems only
'without an apparent reason of failure
MailDoc.SAVEMESSAGEONSEND = SaveIt

'Set up the embedded object and attachment and attach it
If Attachment <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
End If

'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
MailDoc.Send 1
MailDoc.Save True, True, False

'Clean Up
err_h:
Set lErr = Err
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub

Kenneth Hobs
09-10-2012, 12:36 PM
There is no need to quote all code in a post.

The Sub SendNotesMail() has input parameters. The values set in the Sub Test() should be changed to suit "your" needs. PMP handbook text is just text for the Body of the email. Be sure to change who to send it to too. I should have obfuscated my email addresses. Cat is out of the bag now...

dpmaki
09-13-2012, 11:19 AM
So far I changed the ln.GETDATABASE to the .nsf file for me. In the Sub test I also added my email address. So far that is all that I've done in order to try and make this work for me. When I run I'm getting the following error:


Compile error: User-defined type not defined

This line is selected:

Dim ln As lotus.NOTESSESSION

Followed by this group of code getting highlighted in yellow:

Public Sub SendNotesMail(Subject As String, Attachment As String, _
ByVal Recipient As String, _
BodyText As String, _
Optional SaveIt As Boolean = True, _
Optional ByRef lErr As ErrObject)

Kenneth Hobs
09-13-2012, 11:38 AM
What did you do, uncomment the early binding lines? That error means that you have used Dim for an object that you have not bound or set in Tools > References. See the comments for how and what to set for that object.

I use early binding normally. Some like late binding so a production version might have that. Itellisense only works with early bound and dimmed object.

Try using F8 in the test routine to see which line causes the issue.

Good catch on changing the database filename. The routine could add that as an input parameter but for the current user, that would need changed anyway.

dpmaki
09-14-2012, 05:49 AM
I reverted back to the original VBA you posted. Here are the steps that I've taken to the reverted code:

1. Within Sub test I changed out the email address to my own.

2. Under the comment "Open the mail database in notes I added Session.myusername

3. I changed the code within "mail\myusername.nsf"

4. Under comment 'Create an array of recipients (separated by commas) I added my email address

I run macro test, it definitely runs, but I never get an email. Any ideas?

Thanks!

Kenneth Hobs
09-14-2012, 07:03 AM
Give Notes some time to process the code. You may need to click Refresh after 2-3 minutes to refresh notes inbox.

Your nsf file may not be stored in the mail folder. Look at the ozgrid post for the way that Brian obtained the database name. You can find your filename for the database by right clicking it and then Application > Properties.

I simplified the code to avoid a problem with new versions for the To field.
Sub test()
Dim lErr As ErrObject
SendNotesMail _
"PMP Handbook5", _
"c:\t.pdf", _
"khobson@odott.org,khobson@aaahawkk.com", _
"Click file: " & vbCrLf & _
"file://u:\Material\pmp\PMP%20Handbook.pdf" & vbCrLf & _
"or, open the attachement.", , lErr
If lErr.Number <> 0 Then MsgBox lErr.Number & vbCrLf & lErr.Description
End Sub

'Escape characters, %20=space, http://everything2.com/node/1350052
'Similar to: Brian Walters, http://www.ozgrid.com/forum/showthread.php?t=67089
Public Sub SendNotesMail(Subject As String, Attachment As String, _
ByVal Recipient As String, _
BodyText As String, _
Optional SaveIt As Boolean = True, _
Optional ByRef lErr As ErrObject)
'lErr is used when using the Sub in a batch process,
'to handle instances where an error appears

'Example of use:
'SendNotesMail "The Subject", "C:\My Documents\TestFile.txt", _
"john@doe.com, jane@doe.com", _
"This is the body text, can be longer", True, lErr

'Set up the objects required for Automation into lotus notes
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim i As Long 'Counter
Dim oBody As Object 'Body of text in for rich text format

'Early Bind - Tools > Reference > Lotus Notes Automation Classes, notes32.tlb
'Dim ln As lotus.NOTESSESSION
'Set ln = CreateObject("Notes.NotesSession")
'Dim db As lotus.NOTESDATABASE
'Set db = ln.GETDATABASE("", "mail\username.nsf")
'Dim mDoc As lotus.NOTESDOCUMENT
'Set mDoc = db.CREATEDOCUMENT

'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
On Error GoTo err_h

'Open the mail database in notes
UserName = Session.UserName
'************** ADD YOUR username.
Set Maildb = Session.GETDATABASE("", "mail\khobson.nsf")
If Maildb.IsOpen = False Then
Maildb.OPENMAIL
End If

'Set up the new mail document
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = """" & Recipient & """"
MailDoc.Subject = UCase(Subject)
'MailDoc.Body = UCase(BodyText)
Set oBody = MailDoc.CREATERICHTEXTITEM("Body")
oBody.APPENDTEXT BodyText

'This is supposed to be the property, but works
'on some systems only
'without an apparent reason of failure
MailDoc.SAVEMESSAGEONSEND = SaveIt

'Set up the embedded object and attachment and attach it
If Attachment <> "" Then
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
End If

'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
MailDoc.Send 1
MailDoc.Save True, True, False

'Clean Up
err_h:
Set lErr = Err
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
End Sub

shrivallabha
09-15-2012, 03:44 AM
See if this code is of any help to you.

http://www.vbaexpress.com/forum/showpost.php?p=266859&postcount=5

dpmaki
09-17-2012, 06:14 AM
Give Notes some time to process the code. You may need to click Refresh after 2-3 minutes to refresh notes inbox.

Your nsf file may not be stored in the mail folder. Look at the ozgrid post for the way that Brian obtained the database name. You can find your filename for the database by right clicking it and then Application > Properties.

I simplified the code to avoid a problem with new versions for the To field.



I refreshed the VBA with your simplified code and made 2 changes.


Changes made to code:

Under Sub test():

Removed your email address - added mine.


Under Sub SendNotesEmail():

Changed the khobson.nsf to my name.nsf. I did confirm that my .nsf file is within the mail folder.

I made these changes on Friday - ran the sub test numerous times, however still have not received any email. Is there more code within the VBA that I need to change in order for this to work with me. Perhaps I need to uncommentout another section?

Thanks.

dpmaki
09-17-2012, 09:04 AM
See if this code is of any help to you.

http://www.vbaexpress.com/forum/showpost.php?p=266859&postcount=5


Your code works for me. Do you know how I could take this a step further calling a vToList if certain conditions are met within my code.


Example - I have a worksheet titled rebates and within that worksheet I have a formula that puts a "Send Email" in a cell. What I'd like to do is have this run through every worksheet within the workbook and where "Send Email" exists have the vToList look to specified range (whether it be A1 or whatever I choose) to send the email.

I have about 20 worksheets within this workbook, so this one Sub could potentially be responsible for sending 20 separate emails. As long as the criteria is met.

It seems that I could do this by saying if then next if.

Any ideas?

Thanks

shrivallabha
09-18-2012, 10:48 AM
I'd think so what you need to do is:
For i = 1 to Sheets.Count
With Sheets(i)
'The email code comes here with all your checking conditions with qualified ranges.
'For example
If .Range("A1").Value = "Send Email" Then 'So we have to send email
'LN code here!!!
End If
End With
Next i

dpmaki
09-19-2012, 06:35 AM
I'm trying the following - it runs, but I'm not getting an email:

Sub SendEmailUsingCOM()

Dim nSess As Object 'NotesSession
Dim nDir As Object 'NotesDbDirectory
Dim nDb As Object 'NotesDatabase
Dim nDoc As Object 'NotesDocument
Dim nAtt As Object 'NotesRichTextItem
Dim vToList As Variant, vCCList As Variant, vBody As Variant
Dim vbAtt As VbMsgBoxResult
Dim sFilPath As String
Dim sPwd As String

For i = 1 To Sheets.Count
With Sheets(i)
'The email code comes here with all your checking conditions with qualified ranges.
'For example
If .Range("A1").Value = "Yes" Then

Set nSess = CreateObject("Lotus.NotesSession") 'New:{29131539-2EED-1069-BF5D-00DD011186B7}

'************************************************************************** *****************
'This part initializes the session and creates a new mail document
'************************************************************************** *****************


sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)
Call nSess.Initialize(sPwd)
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument

'************************************************************************** *****************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'************************************************************************** *****************
vToList = Application.Transpose(Range("b1").Resize(Range("b" & Rows.Count).End(xlUp).Row).Value)
'vCCList = Application.Transpose(Range("B1").Resize(Range("B" & Rows.Count).End(xlUp).Row).Value)

'************************************************************************** *****************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'************************************************************************** *****************
With nDoc

Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "Test Lotus Notes Email")

With nAtt
.AppendText (Range("C2").Value)

'Decide if you want to attach a file.
vbAtt = MsgBox("Do you want to attach document?", vbYesNo, "Attach Document")

Select Case vbAtt
Case 6
.AddNewLine
.AppendText ("********************************************************************")
.AddNewLine
sFilPath = Application.GetOpenFilename
Call .EmbedObject(1454, "", sFilPath) '1454 = Constant for EMBED_ATTACHMENT
Case 7
'Do Nothing
End Select

End With

Call .ReplaceItemValue("CopyTo", vCCList)
Call .ReplaceItemValue("PostedDate", Now())
'Call .Send(False, vToList)

End With

End If
End With
Next i



End Sub

shrivallabha
09-19-2012, 11:38 AM
Please post a sample workbook with your ranges as they are. The data can be fake but the layout has to match.

dpmaki
09-19-2012, 12:19 PM
Please post a sample workbook with your ranges as they are. The data can be fake but the layout has to match.


Sure - I've attached it.

Thanks for looking at it.

snb
09-19-2012, 02:46 PM
or use:

Sub mail_met_Lotusnotes()
With CreateObject("Notes.NotesSession")
.Initialize "password"
With .Getdatabase("", Left(.UserName, 1) & Right(.UserName, Len(.UserName) - (InStr(.UserName, " "))) & ".nsf")
If Not .IsOpen Then .openmail
With .createdocument
.form = "Memo"
.sendto = Filter([transpose(if('email recipients'!B1:B100="","",'email recipients'!B1:B100))], "@")
.Subject = "subject"
.body = "Body"
.SaveMessageOnSend = True
.createrichtextitem("Attachment").EMBEDOBJECT 1454, "", "E:\Attach\document.xls", "Attachment"
.createrichtextitem "Attachment"
.PostedDate = Now
.send 0, .sendto
End With
End With
End With
End Sub


NB. the commentline has been inserted by this forum's software. consider it to be real VBA.

shrivallabha
09-23-2012, 08:24 AM
Untested as I don't have Lotus Notes at home. I'd suppose, range qualifying would be a problem as we have some more With --- End With.

Here's the code:
Sub SendEmailUsingCOM()

Dim nSess As Object 'NotesSession
Dim nDir As Object 'NotesDbDirectory
Dim nDb As Object 'NotesDatabase
Dim nDoc As Object 'NotesDocument
Dim nAtt As Object 'NotesRichTextItem
Dim vToList As Variant, vCCList As Variant, vBody As Variant
Dim vbAtt As VbMsgBoxResult
Dim sFilPath As String
Dim sPwd As String

For i = 1 To Sheets.Count
If Sheets(i).Range("A1").Value = "Yes" Then

Set nSess = CreateObject("Lotus.NotesSession") 'New:{29131539-2EED-1069-BF5D-00DD011186B7}

'************************************************************************** *****************
'This part initializes the session and creates a new mail document
'************************************************************************** *****************

sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)
Call nSess.Initialize(sPwd)
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument

'************************************************************************** *****************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'************************************************************************** *****************
vToList = Application.Transpose(Sheets(i).Range("B1").Resize(Sheets(i).Range("B" & Rows.Count).End(xlUp).Row).Value)
'vCCList = Application.Transpose(Range("B1").Resize(Range("B" & Rows.Count).End(xlUp).Row).Value)

'************************************************************************** *****************
'If you want to send it to multiple recipients then use variant array to get the names from
'the specified range as below
'Add / Remove Comment mark from vCCList as per your needs.
'************************************************************************** *****************
With nDoc

Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "Test Lotus Notes Email")

With nAtt
.AppendText (Sheets(i).Range("C1").Value)

'Decide if you want to attach a file.
vbAtt = MsgBox("Do you want to attach document?", vbYesNo, "Attach Document")

Select Case vbAtt
Case 6
.AddNewLine
.AppendText ("********************************************************************")
.AddNewLine
sFilPath = Application.GetOpenFilename
Call .EmbedObject(1454, "", sFilPath) '1454 = Constant for EMBED_ATTACHMENT
Case 7
'Do Nothing
End Select

End With

'Call .ReplaceItemValue("CopyTo", vCCList)
Call .ReplaceItemValue("PostedDate", Now())
Call .Send(False, vToList)

End With
End If
Next i

End Sub

dpmaki
09-24-2012, 06:03 AM
There has been a little change of what needs to be done with this code. Instead of checking each individual worksheets - what I need to do instead is check a range. If the range value equals Yes, then an email should be sent to the recipients in the email addresses to the right of the yes.

Example - worksheet named "Email List".

If cell A1 = Yes, Email Recipient in B1 and CC anyone listed in C1.

Next email:

If cell A2 = Yes, Email Recipient in B2 and CC anyone listed in C2.

Next email:

etc.

This should occur through last row which can be defined by an xlup on column A. If any values in column A = No, the VBA should move on to the next populated ranged. So, if A6 = NO, move to A7.

shrivallabha
09-24-2012, 08:52 AM
So does this mean you will be sending one specific sheet to all the users one by one?

See if below helps to get there:
Sub SendEmailUsingCOM()
Dim nSess As Object 'NotesSession
Dim nDir As Object 'NotesDbDirectory
Dim nDb As Object 'NotesDatabase
Dim nDoc As Object 'NotesDocument
Dim nAtt As Object 'NotesRichTextItem
Dim vToList As Variant, vCCList As Variant, vBody As Variant
Dim vbAtt As VbMsgBoxResult
Dim sFilPath As String
Dim sPwd As String

'Assuming the decision is in column A as specified in the last post
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row

If Range("A" & i).Value = "Yes" Then 'If it says then we create email

Set nSess = CreateObject("Lotus.NotesSession") 'New:{29131539-2EED-1069-BF5D-00DD011186B7}

sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)
Call nSess.Initialize(sPwd)
Set nDir = nSess.GetDbDirectory("")
Set nDb = nDir.OpenMailDatabase
Set nDoc = nDb.CreateDocument

vToList = Range("B" & i).Value
vCCList = Range("C" & i).Value

With nDoc

Set nAtt = .CreateRichTextItem("Body")
Call .ReplaceItemValue("Form", "Memo")
Call .ReplaceItemValue("Subject", "Test Lotus Notes Email")

With nAtt
.AppendText ("Dear Sir / Madam" & vbCrLf & "Email As Per Agreement")

vbAtt = MsgBox("Do you want to attach document?", vbYesNo, "Attach Document")

Select Case vbAtt
Case 6
.AddNewLine
.AppendText ("********************************************************************")
.AddNewLine
sFilPath = Application.GetOpenFilename
Call .EmbedObject(1454, "", sFilPath) '1454 = Constant for EMBED_ATTACHMENT
Case 7
'Do Nothing
End Select

End With

Call .ReplaceItemValue("CopyTo", vCCList)
Call .ReplaceItemValue("PostedDate", Now())
Call .Send(False, vToList)

End With
End If
Next i
End Sub

dpmaki
09-24-2012, 09:25 AM
So does this mean you will be sending one specific sheet to all the users one by one?

That works perfectly - do you know if there is a way though to not prompt the user for their password each time an email goes out?

dpmaki
09-24-2012, 10:29 AM
I commented out the sPswd line and that allowed me to run the VBA without any prompts for password. How would I handle bringing in column D and setting the value of D to be the subject for the email?

shrivallabha
09-24-2012, 10:35 AM
That works perfectly - do you know if there is a way though to not prompt the user for their password each time an email goes out?
Good Deal.

Please move this line:
sPwd = Application.InputBox("Type your Lotus Notes password!", Type:=2)

before:
'Assuming the decision is in column A as specified in the last post
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row

so it will prompt only once!

shrivallabha
09-24-2012, 10:37 AM
I commented out the sPswd line and that allowed me to run the VBA without any prompts for password. How would I handle bringing in column D and setting the value of D to be the subject for the email?

By reading the code! It is written clearly!!

dpmaki
09-24-2012, 11:45 AM
By reading the code! It is written clearly!!

Added the following line of code:

Call .ReplaceItemValue("Subject", Range("D" & i).Value)

That did the trick! Thanks again for all your help.

shrivallabha
09-25-2012, 06:19 AM
:clap:

Please mark the thread as solved if this has fulfilled your requirement!