Easily flagging urgent mail items automatically

I recently responded to a request on an internal mailing list for an easy way to flag items automatically with date and time. The user wanted to know how to ensure that he didn't forget an urgent item that he couldn't attend to that very instant.
He had been going through the steps of:

  1. Right-click the item
  2. FollowUp | AddReminder
  3. Set due by time AND date (that sucks!) to sometime today
  4. Click OK

As a solution for him I provided the following macros which make the whole process a lot easier. I personally used the code to remind myself of things further in the future, and have written ForwardToXXX for Today, Tomorrow, NextWeek and NextMonth. It was a relatively easy way to procrastinate without totally forgetting the item.

Anyway, our user added the macro (ForwardToToday) to his toolbar with a shortcut key (alt-m, I think it was) so he could run it very quickly on an item. This macro sets the date and time of the flag to today at 12:00 am. This causes Outlook to bring up a reminder instantly (well, in a short time anyway), which our user could then snooze for whatever length of time he felt was right.
So now the steps are:

  1. Alt-M
  2. Select Snooze By time

Here's the code.

Sub ForwardToDate(forwardDate As Date)
Dim selectedMail As Selection
Dim mail As Outlook.MailItem
    Set selectedMail = Outlook.ActiveExplorer.Selection
For Each mail In selectedMail
If TypeName(mail) = "MailItem" Then
If mail.FlagStatus = olNoFlag Then
mail.FlagStatus = olFlagMarked
mail.FlagIcon = olRedFlagIcon
End If
mail.FlagDueBy = forwardDate
mail.FlagRequest = "Urgent"
End If
Next mail
End Sub

Sub ForwardToToday()
ForwardToDate (Now)
End Sub