[Living the Dream]

Hi Eltyar

Try this instead. Using your spreadsheet, it worked for me.

You can also add signatures too if you have their location. HTH.

Sub sendEmail(eAddress As String, eName As String, eSubject As String, eMessage As String, eSend As String)

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

strbody = "Dear " & eName & ""

On Error Resume Next
With OutMail
.To = eAddress
.CC = ""
.BCC = ""
.Subject = eSubject
.Body = strbody
.Display
'.send 'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Sub sendEmails()

Dim eSend As String
Dim eAddress As String
Dim eName As String
Dim eSubject As String
Dim eMessage As String

For i = 4 To 6

eAddress = Sheets("MRM").Range("I" & i).Value
eName = Sheets("MRM").Range("A" & i).Value
eSubject = Sheets("MRM").Range("K" & i).Value
eMessage = Sheets("MRM").Range("M" & i).Value
eSend = Sheets("MRM").Range("N" & i).Value

If eAddress = "" Then
MsgBox (Sheets("MRM").Range("I" & i).Value & " - does not have a valid email, please change and retry")
Exit For
End If

If eSend = "Y" Then
Call sendEmail(eAddress, eName, eSubject, eMessage, eSend)
Sheets("MRM").Range("O" & i).Value = "Y"
End If

Next i

End Sub