You 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. A video of the macro in action is at the end of the article.
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
Using the macro
This video shows the first macro in action. You need to have macro security set to low to test it.
Use Categories, not Flags
You can watch for categories to be added to the message. In this example, I'm checking for the most recently added category and if there is a match, forward it to another address.
You can use a simple IF... Then statement to forward if you need to forward only one category; the select case statement lets use use multiple categories to send to different addresses.
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) Dim strForward As String Dim arrForward As Variant Dim arrCat As Variant Dim oForward As MailItem If Item.Categories = "Sent" Then Exit Sub arrCat = Split(Item.Categories, ",") If UBound(arrCat) >= 0 Then strCat = Trim(arrCat(0)) Debug.Print strCat Else Exit Sub End If Select Case strCat Case "Email Admin" strForward = "alias1@domain.com" Case "Operations" strForward = "alias2@domain.com" Case "Billing" strForward = "alias3@domain.com" Case "Accounting" strForward = "alias4@domain.com" Case Else Exit Sub End Select Set oForward = Item.Forward oForward.To = strForward oForward.Display ' for testing 'oForward.send 'to send With Item .Categories = "Forwarded;" & Item.Categories .Save End With End Sub
How to use the macro
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 and up, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, itâs at Tools, Macro Security. If Outlook tells you it needs to be restarted, close and reopen Outlook. Note: after you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Now open the VBA Editor by pressing Alt+F11 on your keyboard.
To use the macro code in ThisOutlookSession:
- Expand Project1 and double click on ThisOutlookSession.
- Copy then paste the macro into ThisOutlookSession. (Click within the code, Select All using Ctrl+A, Ctrl+C to copy, Ctrl+V to paste.)
More information as well as screenshots are at How to use the VBA Editor.
Hi Diane, Great and handy macro. But I can't figure out for the life of me how to get this to start with Outlook. I've tried to create is several times along with the signed certificate. I'm using Outlook 2013. Any ideas? Should anything be in the Application_Startup?
As long as it's in thisoutlooksession, it should start when Outlook starts as long as you either have macro security set to low or have signed it and set security to allow signed macros.
Remove the signature from the macro then save the VBA and set macro security to low then restart outlook. Does it work? (Always make sure it works unsigned before signing.)
I really like this code. Thanks so much. However I get an error if someone sends me a calendar appointment. Error is as follows:
Run-time error 438. Object doesn't support this property or method
Debugger highlights 'If Item.IsMarkedAsTask = True Then'
Is there a way to fix? Thanks!
appointments shouldn't be flagged... but you can check for message type too. This should fix it so it only works with messages
If Item.IsMarkedAsTask = True AND item.messageclass = "IPM.Note" Then
right ... it was throwing that error even if I didn't flag (was happening if I click on the appointment). Checking for message type worked though. Thanks!
Hi. Adding the "AND item.messageclass= "IPM.Note" language isn't fixing this for me. Any idea if I need to do something else to stop calendar invites from throwing the run-time error 438?
Try this instead -
right before the If Item.IsMarkedAsTask line, add
If item.messageclass <> "IPM.Note" Then Exit Sub
If Item.IsMarkedAsTask = True Then
This works great except I have to "run" the macro every morning after closing out of outlook the previous day. I have digitally signed the Macro but is there a way to call this automatically on open for every session?
it should run automatically when you restart outlook. Do you have signed macros trusted?
Yes I tried making a new one yesterday and I followed the same practices I did with the first one but this one seems to be working correctly. Not sure where I made the mistake the first time around. Thanks for the quick response!
I am using the create a task from email script and it is working amazing. Now once the task is complete I need outlook to see that and send an email. I have cobbled together the following code but it does not seem to be working... Meaning when I mark complete in the task it doesn't seem to trigger. I have been looking at your various examples for triggering a script when changing a flag. I think I am missing something... Any help would be much appreciated. I have placed the following code in 'ThisOutlookSession'
Sub Item_PropertyChange(ByVal Name)
Set oMsg = Application.CreateItem(olMailItem)
Set objControl = objPage.Controls("TextBox1")
Set objPage = Item.GetInspector.ModifiedFormPages
Set objControl = objPage.Controls("TextBox1")
MyValue = objControl.Value
If Item.Status = olTaskComplete And Item.IsRecurring = False Then
If Item.PercentComplete = 100 Then
With oMsg
.Recipients.Add (MyValue)
.Subject = "Task Completed "
.Body = Item.Subject
.Display
End With
End If
End If
End Sub
I don't think you want to use property change - use the same basic macro as you used to create the task,
At the top of the page:
Public WithEvents OlTaskItems As Outlook.Items
add to the initialize_handler:
Set OlTaskItems = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderTasks).Items
Private Sub OlTaskItems_ItemChange(ByVal Item As Object)
If Item.Status = olTaskComplete Then
Dim Ns As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Set Ns = Application.GetNamespace("MAPI")
Set olMail = Application.CreateItem(olMailItem)
With olMail
.Subject = Item.Subject
.Attachments.Add Item
.Body = Item.Body
.Display
End With
Set Ns = Nothing
End If
End Sub
Diane,
I sent you the macro and form code to your slapstick account...
Thanks Again for all the Help!!!!!!
Donald
Diane,
I want to Thank You!!!! for all your Help!!!! The Macro and Form are working like a Charm!!! do you want me to post the Final code for both?
I have even added additional items to the form, this cuts down ALLOT of time entering IT related service Tickets...
One final thing.. It would be really advantageous to also have the ability to select the macro (which i have as an icon in Outlook) to generate a New Ticket if need be, selecting all the features needed for the ticket and just hit send....
SpiceWorks is very slow and cumbersome.. this works 100% faster with much less effort and is tuned to my needs.. I am at a point which I generate an e-mail to my self, select the macro, fill in what i need to have in it and send..
Thanks Again!!!!
Donald
You can either post the final code or email it to me and I'll post it or link to a text file. email is diane Slipstick.com. It's possible to scrape messages for content, I'll have to see what I can put together.
WOW!!! now I have the Time being added in like it is supposed to - but when i select a Category, it stays at Maintenance ???
Are you using the second code sample? Which flag are you assigning? The .Week category sample may not be accurate for this week/next week, depending on the day of the week.
Diane.. It is working - but fro some reason - after I save and close out of outlook and try to submit a Ticket - it only places the top 2 lines in my combo box : #category Maintenance #add 5m here is the code I have in place: Macro : Public lstNo1 As Long Public lstNo2 As Long Sub HelpdeskNewTicket() Dim helpdeskaddress As String Dim objMail As Outlook.MailItem Dim strbody As String Dim oldmsg As String Dim senderaddress As String Dim addresstype As Integer ' Set this variable as your helpdesk e-mail address helpdeskaddress = "it@jaxbchfl.net" Set objItem = GetCurrentItem() Set objMail = objItem.Forward ' Sender E=mail Address senderaddress = objItem.SenderEmailAddress 'Searches for @ in the email address to determine if it is an exchange user addresstype = InStr(senderaddress, "@") ' If the address is an Exchange DN use the Senders Name If addresstype = 0 Then senderaddress = objItem.SenderName End If UserForm1.Show Select Case lstNo1 Case 0 strCategory = "#category Maintenance" Case 1 strCategory = "#category End User Support" Case 2 strCategory = "#category Hardware" Case 3 strCategory = "#category Software" Case 4 strCategory = "#category iSeries" Case 5 strCategory = "#category Administrative" Case 6 strCategory = "#category… Read more Âğ
Outlook is closed when you do this?