Sub Email()
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim G As Integer
Dim H As Integer
Dim I As Integer
If Range("C4").Value < Range("A2").Value Then
If Range("K4") = "" Then
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "martin.nel2@standardbank.co.za"
.CC = ""
.Subject = "Task not yet completed"
.Body = "Please check 06:00 tasks not done yet!"
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
If Range("C4") + 0.042 < Range("A2") Then
Dim OutApp1 As Object
Dim OutMail1 As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "martin.nel2@standardbank.co.za"
.CC = ""
.Subject = "Task not yet completed"
.Body = "Please check 06:00 tasks not done yet!"
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
End If
End If
If Range("C5").Value < Range("A2").Value Then
A = Application.WorksheetFunction.CountIf(Range("K5:K11"), "")
If A > 0 Then
MsgBox "Werk"
End If
End If
If Range("C12").Value < Range("A2").Value Then
B = Application.WorksheetFunction.CountIf(Range("K12:K17"), "")
If A > 0 Then
MsgBox "Werk"
End If
End If
If Range("C18").Value < Range("A2").Value Then
C = Application.WorksheetFunction.CountIf(Range("K18:K23"), "")
If A > 0 Then
MsgBox "Werk"
End If
End If
If Range("C24").Value < Range("A2").Value Then
D = Application.WorksheetFunction.CountIf(Range("K24:K27"), "")
If A > 0 Then
MsgBox "Werk"
End If
End If
If Range("C28").Value < Range("A2").Value Then
E = Application.WorksheetFunction.CountIf(Range("K28:K32"), "")
If A > 0 Then
MsgBox "Werk"
End If
End If
If Range("C33").Value < Range("A2").Value Then
F = Application.WorksheetFunction.CountIf(Range("K33:K34"), "")
If A > 0 Then
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "martin.nel2@standardbank.co.za"
.CC = ""
.Subject = "Task not yet completed"
.Body = "Please check 06:00 tasks not done yet!"
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
If Range("C33") + 0.042 < Range("A2") Then
Dim OutApp1 As Object
Dim OutMail1 As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "martin.nel2@standardbank.co.za"
.CC = ""
.Subject = "Task not yet completed"
.Body = "Please be adviced that tasks for 11:00 are not done"""
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End If
End If
End If
If Range("C35").Value < Range("A2").Value Then
If Range("K35").Value = "" Then
MsgBox "Werk"
End If
End If
If Range("C36").Value < Range("A2").Value Then
G = Application.WorksheetFunction.CountIf(Range("K36:K56"), "")
If A > 0 Then
MsgBox "Werk"
End If
End If
If Range("C57").Value < Range("A2").Value Then
H = Application.WorksheetFunction.CountIf(Range("K57:K81"), "")
If A > 0 Then
MsgBox "Werk"
End If
End If
If Range("C82").Value < Range("A2").Value Then
I = Application.WorksheetFunction.CountIf(Range("K82:K103"), "")
If A > 0 Then
MsgBox "Werk"
End If
End If
[B] Application.OnTime Now + TimeValue("00:00:30"), "Email"[/B]
End Sub