RSSYou can use the ItemChange event to watch for any change to an item. In this example, the code watches for the QuickFlag block to be clicked then creates a task for the message.
In addition, the flag is cleared and a category applied to the message, so you know that a task exists for the item. Remove those lines if you want the message flag to remain.
This macro needs to go into ThisOutlooksession. To test the macro, click in Initialize_handler then click the Run button. Flag a message and the macro should create a task, displaying it onscreen.
See How to use the VBA Editor if you don't know how to use macros.
Public WithEvents OlItems As Outlook.Items
Public Sub Initialize_handler()
Set OlItems = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub OlItems_ItemChange(ByVal Item As Object)
If Item.IsMarkedAsTask = True Then
Dim Ns As Outlook.NameSpace
Dim olTask As Outlook.TaskItem
Set Ns = Application.GetNamespace("MAPI")
Set olTask = Ns.GetDefaultFolder(olFolderTasks) _
.Items.Add(olTaskItem)
With olTask
.Subject = Item.Subject
.Attachments.Add Item
.Body = Item.Body
.DueDate = Now + 1
.Save
.Display
End With
With Item
.ClearTaskFlag
.Categories = "Task"
.Save
End With
Set Ns = Nothing
End If
End Sub
Set Categories based on the chosen flag
This code sample uses the flags (today, tomorrow, this week, next week) to set the Task due date and determine the category assigned to the email.
This code subtracts today's date from the due date then matches the result with a category. "No date" actually uses a date in year 4501 and in my sample code, I'm looking for differences greater than 20 days.
Public WithEvents OlItems As Outlook.Items
Public Sub Initialize_handler()
Set OlItems = Application.ActiveExplorer.CurrentFolder.Items
End Sub
Private Sub OlItems_ItemChange(ByVal Item As Object)
If Item.IsMarkedAsTask = True Then
Dim Ns As Outlook.NameSpace
Dim olTask As Outlook.TaskItem
Dim newAttachment As Outlook.Attachment
Dim aDate As Date
Dim cat As String
Set Ns = Application.GetNamespace("MAPI")
Set olTask = Ns.GetDefaultFolder(olFolderTasks).Items.Add(olTaskItem)
Set newAttachment = olTask.Attachments.Add(Item, Outlook.OlAttachmentType.olEmbeddeditem)
aDate = Format(Now, "mm/dd/yyyy")
With olTask
.Subject = Item.Subject
.DueDate = Item.TaskDueDate
.Save
.Display
End With
Select Case Item.TaskDueDate - aDate
Case 0
cat = ".Today"
Case 1, 2
cat = ".SOON"
Case 3, 4, 5, 6, 7
cat = ".WEEK"
Case Is <= 20
cat = ".FUTURE"
Case Is > 20
cat = ".NO DATE"
End Select
With Item
.ClearTaskFlag
.Categories = cat
.Save
End With
Set Ns = Nothing
End If
End Sub
