I have created a VBA code to send mails in Excel.

[RobinsonClubnoonu]

Below is the code i have created to send mails through excel . My problem is below for below code i have select each row and then can send mail .
Could some one help me when i sent email button , all mail can go in one time which in my excel cells mention "send reminder".
so is there any way to use it for only the active sheet or work book





Sub btnSendEmail()

Dim objSession As Object
Dim strMailDBName As String
Dim objMailDB As Object
Dim objMailDoc As Object
Dim strSignature As String
Dim varRecipientTo As Variant
Dim varRecipientCC As Variant
Dim strSubject As String

Dim Introw As Integer
Introw = ActiveCell.Row

If ActiveSheet.Range("K" & Introw) <> "" And InStr(1, Trim(ActiveSheet.Range("J" & Introw)), "send reminder", vbTextCompare) <> 0 Then

Set objSession = CreateObject("Lotus.NotesSession")

objSession.Initialize ("MNResmgr") 'énter your Lotus Notes password here

strMailDBName = "mail\mnresmgr.nsf"

Set objMailDB = objSession.GetDatabase("MVDNMN01", strMailDBName)

If Not objMailDB.IsOpen Then Call objMailDB.Open

' Create New Mail and Address Title Handlers
Set objMailDoc = objMailDB.CreateDocument

strSignature = objMailDB.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)

' Select range of e-mail addresses
If InStr(1, ActiveSheet.Range("K" & Introw).Value, ";", vbTextCompare) = 0 Then
varRecipientTo = ActiveSheet.Range("K" & Introw).Value
Else
varRecipientTo = Split(ActiveSheet.Range("K" & Introw).Value, ";")
End If

If InStr(1, ActiveSheet.Range("L" & Introw).Value, ";", vbTextCompare) = 0 Then
varRecipientCC = ActiveSheet.Range("L" & Introw).Value
Else
varRecipientCC = Split(ActiveSheet.Range("L" & Introw).Value, ";")
End If

strSubject = ""
If ActiveSheet.Range("M" & Introw).Value <> "" Then strSubject = ActiveSheet.Range("M" & Introw).Value
If ActiveSheet.Range("F" & Introw).Value <> "" Then
If strSubject = "" Then strSubject = ActiveSheet.Range("F" & Introw).Value Else strSubject = strSubject & " - " & ActiveSheet.Range("F" & Introw).Value
End If

Call objMailDoc.ReplaceItemValue("Form", "Memo")
Call objMailDoc.ReplaceItemValue("SendTo", varRecipientTo)
Call objMailDoc.ReplaceItemValue("CopyTo", varRecipientCC)
Call objMailDoc.ReplaceItemValue("Subject", strSubject)
Dim objMailBody As Object
Set objMailBody = objMailDoc.CreateRichTextItem("Body")
Call objMailBody.AddNewLine(2)
Call objMailBody.AppendText(ActiveSheet.Range("N" & Introw).Value & vbCrLf & vbCrLf & strtSignature)
objMailDoc.SaveMessageOnSend = True
Call objMailDoc.ReplaceItemValue("PostedDate", Now())
On Error GoTo Err_Handler
Call objMailDoc.Send(False)
MsgBox "The email has been sent.", vbOKOnly + vbExclamation, "Ëmail Sent"

End If

Err_Handler:
If Err.Description <> "" Then MsgBox Err.Number & " - " & Err.Description
Set objMailDB = Nothing
Set objMailDoc = Nothing
Set objSession = Nothing

End Sub

[Glenn Kennedy]

Administrative Note:

Welcome to the forum.

We would very much like to help you with your query, however you need to include code tags around your code.

Please take a moment to add the tags. Posting code between tags makes your code much easier to read and copy for testing, and it also maintains VBA formatting.

Please see Forum Rule #2 about code tags and adjust accordingly. Click on Edit to open your post, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

(Note: this change is not optional. No help to be offered until this moderation request has been fulfilled.)