need help with this send email micro
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
|