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.
Mike A says
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?
Diane Poremsky says
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.)
Ken W says
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!
Diane Poremsky says
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
Ken W says
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!
Jordan says
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?
Diane Poremsky says
Try this instead -
right before the If Item.IsMarkedAsTask line, add
If item.messageclass <> "IPM.Note" Then Exit Sub
If Item.IsMarkedAsTask = True Then
Kim I says
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?
Diane Poremsky says
it should run automatically when you restart outlook. Do you have signed macros trusted?
Kim I says
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!
Russ B. says
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
Diane Poremsky says
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
Donald Terrell says
Diane,
I sent you the macro and form code to your slapstick account...
Thanks Again for all the Help!!!!!!
Donald
Donald Terrell says
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
Diane Poremsky says
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.
Donald Terrell says
WOW!!! now I have the Time being added in like it is supposed to - but when i select a Category, it stays at Maintenance ???
Diane Poremsky says
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.
Donald Terrell says
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 EIS"
Case 7
strCategory = "#category Other"
Case 8
strCategory = "#category Network"
Case 9
strCategory = "#category E-Mail"
Case 10
strCategory = "#category Firewall"
Case 11
strCategory = "#category Security"
Case 12
strCategory = "#category Switches"
Case 13
strCategory = "#category SAN"
Case 14
strCategory = "#category UPS"
Case 15
strCategory = "#category GIS"
Case 16
strCategory = "#category Web"
End Select
'UserForm2.Show
Select Case lstNo2
Case 0
strTime = "#add 5m"
Case 1
strTime = "#add 10m"
Case 2
strTime = "#add 30m"
Case 3
strTime = "#add 1hr"
Case 4
strTime = "#add 2hr"
Case 5
strTime = "#add 4hr"
Case 6
strTime = "#add 6hr"
Case 7
strItem = "#add 8hr"
Case 8
strTime = "#add 10hr"
Case 9
strTime = "#add 12hr"
Case 10
strTime = "#add 1day"
Case 11
strTime = "#add 2day"
Case 12
strTime = "#add 3day"
Case 13
strTime = "#add 5Day"
Case 14
strTime = "#add 1week"
Case 15
strTime = "#add 2week"
Case 16
strTime = "#add 1month"
End Select
'adds the senders e-mail address as the created by object for the ticket and appends the message body
strbody = "#created by " & senderaddress & vbNewLine & "#assign Donald Terrell" & vbNewLine & strCategory & vbNewLine & strTime & vbNewLine & "#mute on" & vbNewLine & "#close " & vbNewLine & vbNewLine & objItem.Body
objMail.To = helpdeskaddress
objMail.Subject = objItem.Subject
objMail.BodyFormat = 1 'olFormatPlain'
objMail.Body = strbody
' remove the comment from below to display the message before sending
'objMail.Display
'Automatically Send the ticket
objMail.Display
Set objItem = Nothing
Set objMail = Nothing
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function
Combo Box:
Private Sub ComboBox1_Change()
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_initialize()
With ComboBox1
.AddItem "#category Maintenance"
.AddItem "#category End User Support"
.AddItem "#category Hardware"
.AddItem "#category Software"
.AddItem "#category iSeries"
.AddItem "#category Administrative"
.AddItem "#category EIS"
.AddItem "#category Other"
.AddItem "#category Network"
.AddItem "#category E-Mail"
.AddItem "#category Firewall"
.AddItem "#category Security"
.AddItem "#category Switches"
.AddItem "#category SAN"
.AddItem "#category UPS"
.AddItem "#category GIS"
.AddItem "#category Web"
End With
With ComboBox2
.AddItem "#add 5m"
.AddItem "#add 10m"
.AddItem "#add 30m"
.AddItem "#add 1hr"
.AddItem "#add 2hr"
.AddItem "#add 4hr"
.AddItem "#add 6hr"
.AddItem "#add 8hr"
.AddItem "#add 10hr"
.AddItem "#add 12hr"
.AddItem "#add 1day"
.AddItem "#add 2day"
.AddItem "#add 3day"
.AddItem "#add 5Day"
.AddItem "#add 1week"
.AddItem "#add 2week"
.AddItem "#add 1month"
End With
End Sub
what am I missing?????
Donald
Diane Poremsky says
Outlook is closed when you do this?
Diane Poremsky says
This macro works for me - https://sdrv.ms/YrSLkx (its a text file in skydrive) - i put the code to construct the message after the cases and removed the case -1 - if the selection is blank, nothing is used.
The file only has the VBA macro - the userform code is above. Also, in the userform, you have this in the initialize - take out the lstNo = line from here. the listno lines belong in the commandclick macro.
End With
lstNo = ComboBox2.ListIndex
With ComboBox2
Diane Poremsky says
Oh, and on the insert and change subs outlook adds, that is normal. The editor creates the subs it thinks you are going to use when you do something, like click the dropdown. They can be deleted or left alone. The editor just wants to be helpful. :)
Diane Poremsky says
Also, if the time is going to be used as a time and not text in the body (as in a Due Date, defer until date etc), it needs to be handled a little differently.
Donald Terrell says
Hi Diane,
i am almost there, one thing I am not is a VBA... I have the combo coming up - and it displays all my selections, but it will not insert the selections into the body of the e-mail... here is the code:
Private Sub ComboBox1_Change()
End Sub
(the above lines keep getting inserted into the code ) ??
Private Sub CommandButton1_Click()
lstNo = ComboBox1.ListIndex
lstNo2 = ComboBox2.ListIndex
Unload Me
End Sub
Private Sub UserForm_initialize()
With ComboBox1
.AddItem "#Category Maintenance"
.AddItem "#Category End User Support"
.AddItem "#Category Hardware"
.AddItem "#Category Software"
.AddItem "#Category iSeries"
.AddItem "#Category Administrative"
.AddItem "#Category EIS"
.AddItem "#Category Other"
.AddItem "#Category Network"
.AddItem "#Category E-Mail"
.AddItem "#Category Firewall"
.AddItem "#Category Security"
.AddItem "#Category Switches"
.AddItem "#Category SAN"
.AddItem "#Category UPS"
.AddItem "#Category GIS"
.AddItem "#Category Web"
End With
lstNo = ComboBox2.ListIndex
With ComboBox2
.AddItem "#Add 5m"
.AddItem "#Add 10m"
.AddItem "#Add 30m"
.AddItem "#Add 1hr"
.AddItem "#Add 2hr"
.AddItem "#Add 4hr"
.AddItem "#Add 6hr"
.AddItem "#Add 8hr"
.AddItem "#Add 10hr"
.AddItem "#Add 12hr"
.AddItem "#Add 1days"
.AddItem "#Add 2days"
.AddItem "#Add 3days"
.AddItem "#Add 5Days"
.AddItem "#Add 1weeks"
.AddItem "#Add 2weeks"
.AddItem "#Add 1month"
End With
End Sub
Here is the module code:
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
'adds the senders e-mail address as the created by object for the ticket and appends the message body
strbody = "#created by" & senderaddress & vbNewLine & "#assign Donald Terrell" & vbNewLine & "#mute on" & vbNewLine & "#close " & vbNewLine & vbNewLine & objItem.Body
objMail.To = helpdeskaddress
objMail.Subject = objItem.Subject
objMail.BodyFormat = 1 'olFormatPlain'
objMail.Body = strbody
' remove the comment from below to display the message before sending
'objMail.Display
'Automatically Send the ticket
objMail.Display
UserForm1.Show
Select Case lstNo1
Case -1 'default if not selection
oCategory.AddItem = "1"
Case 0
oAddItem = "#Category Maintenance"
Case 1
oCategory.AddItem "#Category End User Support"
Case 2
oCategory.AddItem "#Category Hardware"
Case 3
oCategory.AddItem "#Category Software"
Case 4
oCategory.AddItem "#Category iSeries"
Case 5
oCategory.AddItem "#Category Administrative"
Case 6
oCategory.AddItem "#Category EIS"
Case 7
oCategory.AddItem "#Category Other"
Case 8
oCategory.AddItem "#Category Network"
Case 9
oCategory.AddItem "#Category E-Mail"
Case 10
oCategory.AddItem "#Category Firewall"
Case 11
oCategory.AddItem "#Category Security"
Case 12
oCategory.AddItem "#Category Switches"
Case 13
oCategory.AddItem "#Category SAN"
Case 14
oCategory.AddItem "#Category UPS"
Case 15
oCategory.AddItem "#Category GIS"
Case 16
oCategory.AddItem "#Category Web"
End Select
'UserForm2.Show
Select Case lstNo2
Case -1 'default if not selection
Case 0
oAddItem = "#Add 5m"
Case 1
oAddItem = "#Add 10m"
Case 2
oAddItem = "#Add 30m"
Case 3
oTime.AddItem "#Add 1hr"
Case 4
oTime.AddItem "#Add 2hr"
Case 5
oTime.AddItem "#Add 4hr"
Case 6
oTime.AddItem "#Add 6hr"
Case 7
oAddItem = "#Add 8hr"
Case 8
oTime.AddItem "#Add 10hr"
Case 9
oTime.AddItem "#Add 12hr"
Case 10
oTime.AddItem "#Add 1days"
Case 11
oTime.AddItem "#Add 2days"
Case 12
oTime.AddItem "#Add 3days"
Case 13
oTime.AddItem "#Add 5Days"
Case 14
oTime.AddItem "#Add 1weeks"
Case 15
oTime.AddItem "#Add 2weeks"
Case 16
oTime.AddItem "#Add 1month"
End Select
Set objItem = Nothing
Set objMail = Nothing
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function
what am i missing to insert hwat ever I select in the combo box ??
Donald
Diane Poremsky says
Oh, how dumb of me not to notice - I questioned ocategory and otime earlier but not the 'additem' part in the Case statement- you don't need this is the case statements.
use something like strCategory = "#Category Firewall" then insert it into the body using strCategory. (If its going to be the category, use objMail.Categories = )
put this after the case, not before and add the strCatehory and strTime to it.
'adds the senders e-mail address as the created by object for the ticket and appends the message body
strbody = "#created by" & senderaddress & vbNewLine & "#assign Donald Terrell" & vbNewLine & "#mute on" & vbNewLine & "#close " & vbNewLine & vbNewLine & objItem.Body
objMail.To = helpdeskaddress
objMail.Subject = objItem.Subject
objMail.BodyFormat = 1 'olFormatPlain'
objMail.Body = strbody
' remove the comment from below to display the message before sending
'objMail.Display
'Automatically Send the ticket
objMail.Display
Donald Terrell says
Hi Diane,
Still Have a bit of an issue.. I have created a user form - and placed 2 combo boxes in it - here is the code :
Private Sub ComboBox1_Insert()
End Sub
Private Sub ComboBox2_Change()
End Sub
Private Sub CommandButton1_Click()
lstNo = ComboBox1.ListIndex
Unload Me
End Sub
Private Sub UserForm_initialize()
With ComboBox1
.AddItem "#Category Maintenance"
.AddItem "#Category End User Support"
.AddItem "#Category Hardware"
End With
End Sub
Private Sub CommandButton2_Click()
lstNo = ComboBox2.ListIndex
Unload Me
End Sub
With ComboBox2
.AddItem "#Add 5m"
.AddItem "#Add 10m"
.AddItem "#Add 30m"
End With
End Sub
Here is my module 1:
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
'adds the senders e-mail address as the created by object for the ticket and appends the message body
strbody = "#created by" & senderaddress & vbNewLine & "#assign Donald Terrell" & vbNewLine & "#mute on" & vbNewLine & "#close " & vbNewLine & vbNewLine & objItem.Body
objMail.To = helpdeskaddress
objMail.Subject = objItem.Subject
objMail.BodyFormat = 1 'olFormatPlain'
objMail.Body = strbody
' remove the comment from below to display the message before sending
'objMail.Display
'Automatically Send the ticket
objMail.Display
UserForm1.Show
Select Case lstNo1
Case -1 'default if not selection
oCategory.AddItem = "1"
Case 0
oCategory.AddItem "#Category Maintenance"
Case 1
oCategory.AddItem "#Category End User Support"
Case 2
oCategory.AddItem "#Category Hardware"
End Select
UserForm2.Show
Select Case lstNo2
Case -1 'default if not selection
Case 0
oTime.AddItem "#Add 5m"
Case 1
oTime.AddItem "#Add 10m"
Case 2
oTime.AddItem "#Add 30m"
End Select
Set objItem = Nothing
Set objMail = Nothing
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function
it partially works , I can only get 1 drop down with a listing the other does not.. so what I am trying to do is via the drop dons is to insert, based on the selected drop - Time or Category and place in the e-mail body - in certain places : behind the #assign Donald Terrell : strbody = "#created by" & senderaddress & vbNewLine & "#assign Donald Terrell" & vbNewLine & "#mute on" & vbNewLine & "#close " & vbNewLine & vbNewLine & objItem.Body
then send... if by any chance you can contact me directly would be most appreciated..
Donald
dfterrell@comcast.net
Diane Poremsky says
You can remove the bold lines, move lstNo line to the command button and change it to lstNo2 - the two combobox lists will be in one sub.
End Sub
Private Sub CommandButton2_Click()
lstNo2 = ComboBox2.ListIndex
Unload Me
End Sub
It will look like this (but with more lines)
Private Sub CommandButton1_Click()
lstNo = ComboBox1.ListIndex
lstNo2 = ComboBox2.ListIndex
Unload Me
End Sub
Private Sub UserForm_initialize()
With ComboBox1
.AddItem "#Category Maintenance"
.AddItem "#Category End User Support"
End With
With ComboBox2
.AddItem "#Add 5m"
.AddItem "#Add 10m"
End With
End Sub
I can't test it beyond that because oCategory fails with object required.
screenshot: https://screencast.com/t/0dbEiE6yg
Diane Poremsky says
oh, i didn't see you have 2 userforms. Same deal should work - you need to initialize the list(s) and the combobox list will control which list is populated.
Private Sub UserForm_initialize()
With ComboBox1
'lists
end with
With combobox2
'lists
end with
Brian says
If it makes it any easier I don;t need the flag to dictate the due date, I'm fine with the +3 that comes from the script. I was just trying to reassign the flag choices that were already there because I don't use to-do flags
Diane Poremsky says
That doesn't make a difference. I'm trying to figure out why the date is passing to the if statement to set the category... it's more interesting than the work I'm supposed to be doing. :) Once I know why it's not working, then you can work with any date.
Diane Poremsky says
Ok... finally - it works if I pass the date as a variable.
up with the rest of the declarations:
Dim aDate As Date
and this up with the Set lines:
aDate = Format(Now, "mm/dd/yyyy")
you can use
If Item.TaskDueDate = aDate Then 'today
If Item.TaskDueDate = aDate + 1 Then ' tomorrow
If Item.TaskDueDate = aDate + 7 Then ' 1 week
If Item.TaskDueDate > aDate + 7 Then ' future
Dang, now I can't put off work any longer. :(
Diane Poremsky says
Actually that is not working quite right either. :(
Brian says
Spinning my wheels a bit here. Below is the entire code I am working with in Outlook 2007.
Desired State: Clicking the followup flag in an email in any folder triggers a task with the original email attached in the task body, but does NOT paste the message body into the task body. Depending on which flag is clicked (Today, Tomorrow, etc.), the resulting task should be categorized as NEXTACTION, WAITINGFOR, etc.. The original email should be categorized as PROCESSED when the routine is done.
Current state: clicking the followup flag correctly creates a task with the orig email attached in the task body, and does not paste the email body into the task body. However, while the email looks correct by the subject line that appears under the envelop icon in the task body, opening it just brings up a blank "new message" without any info in the subject line. The task is not categorized at all. The original email is correctly categorized as PROCESSED.
Other notes: I am not sure I am using the correct variables for FlagStatus ("Today" versus "1"?) Can't find any listing of what those options would be. Also, some of this code is taken from your other posting about triggering tasks with rules, but the ItemChange method seems to require different methods
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
Set Ns = Application.GetNamespace("MAPI")
Set olTask = Ns.GetDefaultFolder(olFolderCalendar) _
.Items.Add(olTaskItem)
With olTask
.Subject = Item.Subject
Dim newAttachment As Outlook.Attachment
.DueDate = Now + 3
If Item.FlagStatus = 1 Then
.ClearTaskFlag
.Categories = ".NEXT ACTION"
.Save
End If
Set newAttachment = olTask.Attachments.Add(Item, Outlook.OlAttachmentType.olEmbeddeditem)
.Save
.Display
End With
With Item
.ClearTaskFlag
.Categories = "PROCESSED"
.Save
End With
Set Ns = Nothing
End If
End Sub
Diane Poremsky says
I'll take a look at this tonight as soon as i get a project finished - but one thing - i discovered an error in the original code yesterday - Set olTask = Ns.GetDefaultFolder(olFolderCalendar) _ should be Set olTask = Ns.GetDefaultFolder(olFoldertasks) _ - don't ask me how I screwed that up in a copy and paste, but I did. :(
Diane Poremsky says
In a real quickie test, i added .save after setting the due date - that sets the flag so the status can be read. But flag status doesn't pick up on the date, it returns complete, marked, or no flag. Use .DueDate = Item.TaskDueDate to pick up the today, tomorrow, this week etc.
Use something like If Item.TaskDueDate = Format(Now, "mm/dd/yyyy") Then 'for today
to assign the next action category. (but that is not working for me.)
This is my test code - dim the attachment with the other dim's.
[code lang="vb"]
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
Set Ns = Application.GetNamespace("MAPI")
Set olTask = Ns.GetDefaultFolder(olFolderTasks) _
.Items.Add(olTaskItem)
With olTask
.Subject = Item.Subject
.DueDate = Item.TaskDueDate
.Save
If Item.FlagStatus = 1 Then
.ClearTaskFlag
.Categories = ".NEXT ACTION"
.Save
End If
Set newAttachment = olTask.Attachments.Add(Item, Outlook.OlAttachmentType.olEmbeddeditem)
.Save
.Display
End With
With Item
.ClearTaskFlag
.Categories = "PROCESSED," & .Categories
.Save
End With
Set Ns = Nothing
End If
End Sub
[/code]
Brian says
All folders now working. Not sure what to do with IF stmts. I'm not a VBA programmer, just an overzealous end user, so sort of faking my way through this.
I adjusted the following lines. but it failed in a different way than I expected ("end with without with"),
With Item
If Item.FlagStatus = Today Then
.ClearTaskFlag
.Categories = ".NEXT ACTION"
.Save
End With
Where would these if stmts need to go within the code, does it matter?
Diane Poremsky says
The problem here is a missing End if
With Item
If Item.FlagStatus = Today Then
.ClearTaskFlag
.Categories = ".NEXT ACTION"
.Save
end if
End With
The due date is hard coded in the sample macro but you could use an input box and enter a number of days ahead to create the due date then use your code block after the task is created.
Brian says
Great tips, very helpful as I build out a GTD approach! Two follow up questions:
Is it possible to have this behavior occur in any email folder (esp. sent items)?
Can different flags trigger different categories while creating the task?
.ie, if I flag it as Today, that would create a task and categorize as "Next Action", but if flagged as Tomorrow, it would categorize "Waiting For"
Diane Poremsky says
You can use if statements to set different options.
Applying it to all folders is as simple as changing the Set olitems line to this:
Set OlItems = Application.ActiveExplorer.CurrentFolder.Items
Donald Terrell says
Sorry Diane I posted to the wrong page - I should have posted to your "Outlook Userform and Combo boxes"
This is what I get when the mail displays:pauses
#created bymailman-owner@csc.noaa.gov
#assign Donald Terrell
#mute on
#close
After the #assign - via through your combo box - I would like to select and place a "Category" and "Time"
#created bymailman-owner@csc.noaa.gov
#assign Donald Terrell
#Category GIS
#add 5m
#mute on
#close
He is the string I have in my macro
'adds the senders e-mail address as the created by object for the ticket and appends the message body
strbody = "#created by" & senderaddress & vbNewLine & "#assign Donald Terrell" & vbNewLine & "#mute on" & vbNewLine & "#close " & vbNewLine & vbNewLine & objItem.Body
What I am trying to do is use your Combo Box to stop my macro, hit your combo box, insert certain stuff into it in the above mail display with the #'s.... what this will do is insert a #Category GIS, and #add 5m -
Diane Poremsky says
Sorry I haven't had a chance to check out this code yet - I'm going to try and check it out this weekend.
Donald Terrell says
I am trying to use use a macro in this site:
https://community.spiceworks.com/how_to/show/1964-add-a-button-to-outlook-that-will-forward-an-e-mail-to-the-helpdesk-as-a-new-ticket#comments
I have the macro working, but I would like to have the ability to Pause it, display, and be able to have 2 drop down boxes for selections that would be imbedded in the mail and sent to our ticket system.
any chance you can contact me on this.
Donald
Diane Poremsky says
pausing the macro is as simple as removing the send line:
'Automatically Send the ticket
objMail.Send
and replacing it with
objMail.Display
that opens the message onscreen and you need to hit send.
The dropdowns can be done using userforms.
add this after the display line:
[code lang="vb"]
UserForm1.Show
Select Case lstNo
Case -1 'default if not selection
oMail.Subject = "1"
Case 0
oMail.Subject = "1"
Case 1
oMail.Subject = "2"
End Select
Select Case lstNo2
Case -1 'default if not selection
oMail.Subject = "1"
Case 0
oMail.Subject = "1"
Case 1
oMail.Subject = "2"
End Select[/code]
* you'll need these at the top of the macro
[code lang="vb"]
Public lstNo As Long
Public lstNo2 As Long
[/code]
and this in the userform along with both comboboxes.
[code lang="vb"]
Private Sub CommandButton1_Click()
lstNo = ComboBox1.ListIndex
lstNo2 = ComboBox2.ListIndex
Unload Me
End Sub
[/code]
Diane Poremsky says
of course, the oMail.Subject in the select case can be changed to a string, an address or whatever is needed - i just copied that from the other macro as an example.