Option Explicit Dim SetFlag Private WithEvents olSentItems As Items Private Sub Application_Startup() Dim objNS As NameSpace Set objNS = Application.Session ' instantiate objects declared WithEvents Set olSentItems = objNS.GetDefaultFolder(olFolderSentMail).Items Set objNS = Nothing End Sub Private Sub olSentItems_ItemAdd(ByVal Item As Object) On Error Resume Next Dim prompt As String If SetFlag = vbYes Then With Item .MarkAsTask olMarkThisWeek ' sets a due date in 3 days .TaskDueDate = Now + 3 .ReminderSet = True .ReminderTime = Now + 2 .Save End With End If SetFlag = vbNo End Sub Sub SayYes() SetFlag = vbYes End Sub