Email not working

[Cassatt]

Hi, Email not working. When command button/vba is running a excel icon w/red X dot will surface then it turn gray and disappear after message box is accepted.

Excel worksheet ("Email Timesheet")

In column A-F

A : Staff Id “ID”
B : Staff Names “Name”
C : E-mail addresses “eMail Id”
D : Attachment “Attachment”
E : email text message “Body”

send_email_complete()



Dim OutApp As Object

Dim OutMail As Object

Dim sh As Worksheet

Dim cell As Range

Dim FileCell As Range

Dim rng As Range

Dim epar As Range





With Application

.EnableEvents = False

.ScreenUpdating = False

End With



Set sh = Sheets("Email Timesheet")



Set OutApp = CreateObject("Outlook.Application")



For Each cell In sh.Columns("C").Cells.SpecialCells(xlCellTypeConstants)



Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")



If cell.Value Like "?*@?*.?*" And _

Application.WorksheetFunction.CountA(rng) > 0 Then

Set OutMail = OutApp.CreateItem(0)



With OutMail

.to = cell.Value

.Body = cell.Value



For Each FileCell In rng.SpecialCells(xlCellTypeConstants)

If Trim(FileCell) <> "" Then

If Dir(FileCell) <> "" Then

.Attachments.Add FileCell.Value



End If

End If



Next FileCell

.Send 'or .Display

End With



Set OutMail = Nothing

End If

Next cell



Set OutApp = Nothing

With Application

.EnableEvents = True

.ScreenUpdating = True



MsgBox "EMAIL SENT TO STAFF COMPLETE"





End With

End Sub