Option Explicit

Sub RemindMsg()
Dim olMsg As MailItem
    On Error GoTo err_handler
    Set olMsg = ActiveExplorer.Selection.Item(1)
    FlagMessage olMsg
lbl_Exit:
    Exit Sub
err_handler:
    MsgBox Err.Number & vbCr & Err.Description & vbCr & vbCr & _
           "Ensure you have a message selected before running the test macro!"
    GoTo lbl_Exit
End Sub

Public Sub FlagMessage(olItem As Outlook.MailItem)
Dim strTime As String
Dim strDays As String
    strDays = InputBox("Remind in how many days?")
    If strDays = "" Then strDays = 1
    strTime = Now + Val(strDays)
    With olItem
        AddAppt .Subject & " - " & .SenderEmailAddress, strTime
        .MarkAsTask olMarkThisWeek
        .ReminderSet = True
        .ReminderTime = strTime
        .Save
    End With
lbl_Exit:
    Exit Sub
End Sub

Public Sub AddAppt(strSubject As String, strTime As String)
Dim objApt As AppointmentItem
    Set objApt = Application.CreateItem(olAppointmentItem)
    With objApt
        .ReminderSet = False
        .Subject = strSubject
        .Start = strTime
        .AllDayEvent = True
        .Save
    End With
lbl_Exit:
    Exit Sub
End Sub