Sub Test1()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
Dim strgreeting As String
For Each cell In Range("M8")
strgreeting = cell.Value
Next
Dim strsignoff As String
For Each cell In Range("M9")
strsignoff = cell.Value
Next
Dim strsubject As String
For Each cell In Range("F11")
strsubject = cell.Value
Next
Dim strbody As String
For Each cell In Range("F14:F14")
strbody = strbody & cell.Value & vbNewLine
Next
For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeFormulas)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "D").Value) = "n" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.CC = ""
.BCC = ""
.Subject = strsubject
.body = strgreeting & " " & Cells(cell.Row, "B").Value & vbNewLine & vbNewLine & strbody & strsignoff
'You can add files also like this
'.Attachments.Add ("C:\\\\filename.filetype")
.Send ' Or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub
The emails send perfectly to all email addresses in the specified range. The only thing I would like now is for the code to include my outlook signature, which is a name and image! I tried another method whereby the outlook message would pop up for a second, thinking it would automatically populate the signature, but I had no luck!
