Outlook VBA add reminder to message code
Attribute VB_Name = "Reminders"
Option Explicit
Const olTaskDateNone = "4501-01-01"
Public Sub AddReminder(objMsg As Object, Optional dateTime As Date, Optional TaskDueInDays As Double)
' Dim objMsg As Object
' GetCurrent Item function is athttp://slipstick.me/e8mio
'Set objMsg = GetCurrentItem()
If IsMissing(dateTime) Then dateTime = Int(Now) + 16 / 24
With objMsg
' due this week flag
.MarkAsTask olMarkThisWeek
''.TaskStartDate = olTaskDateNone
.TaskDueDate = olTaskDateNone
' sets a specific due date
If TaskDueInDays > 0 Then
.TaskDueInDays = Now + TaskDueInDays
.TaskDueDate = TaskDueInDays + Int(Now)
.FlagRequest = "REMINDER FOR: " & objMsg.SenderName
End If
.ReminderSet = True
.ReminderTime = dateTime
.Save
End With
Set objMsg = Nothing
End Sub
Public Sub REM_NEXT_1200p(item As Outlook.MailItem)
Dim remind As Date
Dim lead As Date
lead = Round(Now * 24 + 1) / 24 ''1 hour min lead time
remind = Int(Now) + 12 / 24
If remind < lead Then remind = remind + 1 ''push to next day
AddReminder item, remind
End Sub
Public Sub REM_NEXT_1600p(item As Outlook.MailItem)
Dim remind As Date
Dim lead As Date
lead = Round(Now * 24 + 1) / 24 ''1 hour min lead time
remind = Int(Now) + 16 / 24
If remind < lead Then remind = remind + 1 ''push to next day
AddReminder item, remind
End Sub
Public Sub REM_AfterHour_On_Hour(item As Outlook.MailItem)
Dim remind As Date
Dim lead As Date
lead = Round(Now * 24 + 2) / 24 ''1 hour min lead time
AddReminder item, lead
End Sub
Public Sub REM_Next_8_12_04(item As Outlook.MailItem)
Dim remind As Date
Dim lead As Date
lead = Round(Now * 24 + 2) / 24 ''1 hour min lead time
remind = Int(Now) + 8 / 24
If remind < lead Then remind = Int(Now) + 12 / 24 'today 12p
If remind < lead Then remind = Int(Now) + 16 / 24 'today 4pm
If remind <= lead Then remind = Int(Now) + 1 + 8 / 24 'tomorrow 8a
AddReminder item, remind
End Sub
Comments
Post a Comment