Outlook: Sending emails with attachments using reminder

Option Explicit
Private WithEvents colReminders As Outlook.Reminders
Private Sub Application_Startup()
    Set colReminders = Application.Reminders
End Sub
Private Sub colReminders_BeforeReminderShow(Cancel As Boolean)
' Note: this will suppress all reminders in this session
    Cancel = True 'cancel showing reminders window
End Sub

Private Sub colReminders_ReminderFire(ByVal ReminderObject _
    As Reminder)
' Processes ALL reminders
Dim objTask As Outlook.TaskItem
' ====================================================
Dim dblNow As Double
Dim dblTime As Double
Dim intHour As Integer
Dim intMinute As Integer
Dim dtNextReminder As Date
Dim strTaskSubject As String
Dim intReminderHours As Integer
Dim intDayNumber As Integer
Dim intTaskID As Integer
'
' Ignore any errors:
    On Error GoTo Exit_Para
    '
    strTaskSubject = ReminderObject.Caption
    intReminderHours = 1 'safety-net
    '
' ****************************************************
' ****************************************************
' ****************************************************
' ====================================================
    ' ALLOW ONLY "APPROVED" TASKS BEYOND THIS POINT:
    If ((strTaskSubject <> "My Task Subject 1") And _
        (strTaskSubject <> "My Task Subject 2")) Then
        GoTo Exit_Para
    End If
' ====================================================
' ****************************************************
' ****************************************************
' ****************************************************
' My Task Subject 1:
    If strTaskSubject = "My Task Subject 1" Then
        intReminderHours = 24 ' one day
        '
        ' Do something here
        '
    End If
' ====================================================
' My Task Subject 2:
    If strTaskSubject = "My Task Subject 2" Then
        intReminderHours = 168 'one week
        '
        ' Do something here
        '
    End If
' ====================================================
' RESET REMINDER:
    ' Prepare time for next instance of task:
    dtNextReminder = ReminderObject.NextReminderDate + TimeSerial(intReminderHours, 0, 0)
    ' Remove reminder:
    ReminderObject.Dismiss
    '
    ' Reset (new) task for next action:
    Set objTask = Outlook.CreateItem(olTaskItem)
    With objTask
        .StartDate = dtNextReminder
        .Subject = strTaskSubject
    '       .Status = olTaskInProgress
    '       .Importance = objItem.Importance
        .DueDate = dtNextReminder
        .ReminderSet = True
        .ReminderTime = dtNextReminder
        .Save
    End With
    '
    ' Now tidy old tasks:
    TidyTasks
    '
Exit_Para:
'
Set objTask = Nothing
'
End Sub

Option Explicit
Sub TidyTasks()
Dim objTaskFolder As Outlook.MAPIFolder
Dim objTaskItems As Outlook.Items
Dim objNS As Outlook.NameSpace
Dim objTaskItem As Outlook.TaskItem
Dim lngKount As Long
'
Set objNS = Application.GetNamespace("MAPI")
Set objTaskFolder = objNS.GetDefaultFolder(olFolderTasks)
Set objTaskItems = objTaskFolder.Items
  For lngKount = objTaskItems.Count To 1 Step -1
    If IsTask(objTaskItems.Item(lngKount)) Then
        Set objTaskItem = objTaskItems.Item(lngKount)
        If ((objTaskItem.Subject = "My Task Subject 1") Or _
                (objTaskItem.Subject = "My Task Subject 2")) Then
            If objTaskItem.ReminderTime < (Now() - TimeValue("12:00:00")) Then
                ' more than 12 hours old, so delete
                objTaskItem.Delete
            End If
        End If
    End If
  Next lngKount
Set objTaskItems = Nothing
Set objTaskFolder = Nothing
Set objNS = Nothing
End Sub
Function IsTask(oItem As Object) As Boolean
  IsTask = (TypeName(oItem) = "TaskItem")
End Function

' My Task Subject 1:
    If strTaskSubject = "My Task Subject 1" Then
        intReminderHours = 24 ' one day
        '
        ' Do something here
        '
    End If