Send Mail Macro

Hello,
I have created a macro to send an email if certain conditions are met but when I run the macro nothing happens. Can anyone spot the problem? If you need more information about the workbook please ask.

Kindly, Jordan

Sub SendEMail()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

On Error GoTo cleanup
For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "E").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Notice of Renwal: WSIB Certificate of Clearance"
.Body = "Dear " & Cells(cell.Row, "B").Value _
& vbNewLine & vbNewLine & _
"The effective period on your W.S.I.B Certificate of Clearance ends " & Cells(cell.Row, "D").Value _
& vbNewLine & _
"Please renew and submit this certificate before this time." & _
vbNewLine & vbNewLine & _
"Regards," & _
vbNewLine & _
"Kelly Roccha" & _
vbNewLine & _
"The Effort Trust Company"


'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Display
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%S"
'Or use Display

End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell