Emails during business hours

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Const morningTime As String = “08:30:00”
Const eveningTime As String = “19:00:00”

Dim mi As Outlook.MailItem
Dim dow As Integer
Dim time As String
Dim itIsLate As Boolean
Dim itIsEarly As Boolean

On Error GoTo ErrorHandler

 

Set mi = Item

dow = Weekday(Date, vbMonday)
time = Format(Now, “HH:NN:SS”)
itIsLate = (StrComp(time, eveningTime) > 0)
itIsEarly = (StrComp(morningTime, time) > 0)

 

If (dow = 6) Or (dow = 7) Or _
((dow = 5) And itIsLate) Then
‘  Weekend! Delay until Monday morning

‘ 6=vbSaturday,7= vbSunday and 5=vbFriday

mi.DeferredDeliveryTime = (Date + (7 – dow + 1)) _
& ” ” & morningTime

ElseIf itIsLate Then
‘  in the evening, delay until next morning
mi.DeferredDeliveryTime = (Date + 1) & ” ” & morningTime

ElseIf itIsEarly Then
‘  if you send an email after midnight, this delays until morning
mi.DeferredDeliveryTime = (Date) & ” ” & morningTime

End If

Exit Sub
ErrorHandler:

MsgBox “Application_ItemSend: ” & Err.Description

End Sub