|OLKeeper reliably prevents users from closing their Outlook window and thus possibly missing reminders or e-mails.|
Do you also have your rules for flagging e-mails for follow-up? For instance, less urgent items for 'this evening'; see whether or not the customer has answered yet for 'next week', etc. This VBA sample helps you save some time by determining a date and time for certain cases.
The main piece is the following procedure. Pass to it the number of days for when the task should be due (0 for today, 1 for tomorrow, etc.). Optionally you can also pass a time, and a subject for the task. See also some samples below for calling the procedure.
Either paste the code into the existing module 'ThisOutlookSession', or add a new 'Module' and paste the code there.
Public Sub MarkItemAsTask(ByVal AddDays As Long, _ Optional TimeOfDay As String = "08:00", _ Optional Subject As String, _ Optional Mail As Outlook.MailItem _ ) Dim Items As VBA.Collection Dim obj As Object Dim i As Long Dim dt As Date Dim tm As String Dim Icon As OlMarkInterval dt = DateAdd("d", AddDays, Date) tm = CStr(dt) & " " & TimeOfDay If AddDays < 1 Then Icon = olMarkToday ElseIf AddDays = 1 Then Icon = olMarkTomorrow ElseIf Weekday(Date, vbUseSystemDayOfWeek) + AddDays < 8 Then Icon = olMarkThisWeek Else Icon = olMarkNextWeek End If If Mail Is Nothing Then Set Items = GetCurrentItems Else Set Items = New VBA.Collection Items.Add Mail End If For Each obj In Items If TypeOf obj Is Outlook.MailItem Then Set Mail = obj Mail.MarkAsTask Icon Mail.TaskStartDate = tm Mail.TaskDueDate = tm If Len(Subject) Then Mail.TaskSubject = Subject Mail.FlagRequest = Subject End If Mail.ReminderTime = tm Mail.ReminderSet = true Mail.Save End If Next End Sub Private Function GetCurrentItems() As VBA.Collection Dim c As VBA.Collection Dim Sel As Outlook.Selection Dim obj As Object Dim i& Set c = New VBA.Collection If TypeOf Application.ActiveWindow Is Outlook.Inspector Then c.Add Application.ActiveInspector.CurrentItem Else Set Sel = Application.ActiveExplorer.Selection If Not Sel Is Nothing Then For i = 1 To Sel.Count c.Add Sel(i) Next End If End If Set GetCurrentItems = c End Function
|VBOffice Reporter is an easy to use tool for data analysis and reporting in Outlook. A single click, for instance, allows you to see the number of hours planned for meetings the next month.|
Here come two samples for how to call the function. The first one creates a task due tomorrow, and the task will get the subject of the email. The second one creates a task due the day after tomorrow with the subject 'Send reply'. Rename the functions to suit your needs, for instance, 'DueTomorrow' instead of 'Sample_1'.
If a folder is the active window in Outlook when you call this functions, then all selected emails will be flagged. Instead, if an open email is the active window, then only that one will be flagged.
Another way would be to trigger the flagging from another macro. For instance, you could trigger the creation of a task item by assigning a category to the email. See also Trigger Actions with Categories.
Public Sub Sample_1() 'due: tomorrow, 8 o´clock MarkItemAsTask 1 End Sub Public Sub Sample_2() 'due: the day after tomorrow, 11 o´clock MarkItemAsTask 2, "11:00", "Send reply" End Sub
|Determine the "identity" of your emails. Set with SAM the sender and the folder folder for sent items with the help of rules.|
Before Outlook 2007 there was no Todo bar. This old sample for Outlook 2003 is different from the one above but serves it's purpose, too.
Public Enum FlagWhatEnum flNextWeek = 0 flThisEvening = 1 flTomorrow = 2 End Enum Public Sub FlagNextWeek() FlagItem flNextWeek End Sub Public Sub FlagThisEvening() FlagItem flThisEvening End Sub Public Sub FlagTomorrow() FlagItem flTomorrow End Sub Private Sub FlagItem(FlagWhat As FlagWhatEnum) Dim Mail As Outlook.MailItem Dim obj As Object Dim Sel As Outlook.Selection Dim i& Dim dt As Date Dim tm As String Dim Icon As OlFlagIcon Select Case FlagWhat Case flNextWeek dt = DateAdd("d", 7, Date) tm = CStr(dt) & " 08:00" Icon = olOrangeFlagIcon Case flThisEvening dt = Date tm = CStr(dt) & " 19:00" Icon = olYellowFlagIcon Case flTomorrow dt = DateAdd("d", 1, Date) tm = CStr(dt) & " 08:00" Icon = olYellowFlagIcon End Select Set obj = Application.ActiveWindow If TypeOf obj Is Outlook.Explorer Then Set Sel = obj.Selection For i = 1 To Sel.Count Set obj = Sel(i) If TypeOf obj Is Outlook.MailItem Then Set Mail = obj Mail.FlagDueBy = tm Mail.FlagIcon = Icon Mail.Save End If Next Else Set obj = obj.CurrentItem If TypeOf obj Is Outlook.MailItem Then Set Mail = obj Mail.FlagDueBy = tm Mail.FlagIcon = Icon Mail.Save End If End If End Sub
|ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail.|