Categories
Microsoft Office Productivity Technology

Useful Outlook Macros

Quite often I want to create a task immediately off the back of sending an e-mail – usually to remind me to follow up with the recipient after a period of time. I created a macro to do this rather than having to remember to go into tasks and do this manually – better to keep the flow rather than having to remember the steps.

The code to implement this is as follows:

Private WithEvents CalItems As Outlook.Items
Private WithEvents MailItems As Outlook.Items
 Private Sub Application_Startup()
    Dim NS As Outlook.NameSpace
    Set NS = Application.GetNamespace("MAPI")
    Set CalItems = NS.GetDefaultFolder(olFolderCalendar).Items
    Set MailItems = NS.GetDefaultFolder(olFolderInbox).Items
'    If MsgBox("Print Todays Calendar?", vbYesNo) = vbYes Then
'        printCalendar
'    End If
End Sub
Private Sub CalItems_ItemAdd(ByVal item As Object)
    On Error Resume Next
    Dim Appt As Outlook.AppointmentItem
    If TypeOf item Is Outlook.AppointmentItem Then
        Set Appt = item
        If Appt.ReminderSet = False Then
            If MsgBox("NO REMINDER IS SET! Do you want to add one?", vbYesNo) = vbYes Then
                Appt.ReminderSet = True
                Appt.ReminderMinutesBeforeStart = 15
                Appt.Save
            End If
        End If
    End If
End Sub
Private Sub MailItems_ItemAdd(ByVal item As Object)
    Dim objAtt As Outlook.Attachment
    Dim saveFile As String
    Dim dateFormat As String
    dateFormat = Format(item.ReceivedTime, "yyyymmdd")
    Dim saveFolder As String
    saveFolder = "C:\RGFolders\OutlookAttachments" & "\" & dateFormat
    If (Dir$(saveFolder, vbDirectory) = "") Then
        MkDir saveFolder
    End If
    For Each objAtt In item.Attachments
        saveFile = saveFolder & "\" & objAtt.DisplayName
        objAtt.SaveAsFile saveFile
        'MsgBox ("Saved " & saveFile)
    Next
End Sub
Private Sub Application_ItemSend(ByVal item As Object, cancel As Boolean)
    Dim olApp   As Outlook.Application
    Dim olTask  As Outlook.TaskItem
    'Dim olMessage As Outlook.MailItem
    'olMessage.To
    If TypeOf item Is Outlook.MailItem Then
        If item.Subject = "" Then
            If MsgBox("This message has no subject, are you sure you want to send it?", vbYesNo + vbQuestion, "Confirm") = vbNo Then
                cancel = True
            End If
        End If
        If MsgBox("Create A Follow Up Task?", vbYesNo) = vbYes Then
            Set olApp = Application
            Set olTask = olApp.CreateItem(olTaskItem)
            olTask.Subject = "Follow Up : " & item.To & " : About : " & item.Subject
            If Format(item.SentOn, "dd/mm/yyyy") = "01/01/4501" Then
                dateSent = Now
            Else
                dateSent = item.SentOn
            End If
            olTask.Body = olTask.Body & "Sent : " & Format(dateSent, "dd MMMM yyyy hh:mm:ss") & vbCrLf
            olTask.Body = olTask.Body & "To : " & item.To & vbCrLf
            olTask.Body = olTask.Body & "Subject : " & item.Subject & vbCrLf
            olTask.Body = olTask.Body & "Body : " & item.Body & vbCrLf
            'olTask.ContactNames = Item.To
            olTask.Categories = Replace(item.To, ",", "-")
            'MsgBox (Item.To)
            olTask.DueDate = Date + 1
            olTask.Status = olTaskWaiting
            olTask.Display
            olTask.Save
        End If
    End If
End Sub
Public Sub printCalendar()
SendKeys "^2", True 'Select Calendar
SendKeys "%o", False 'Select Today
SendKeys "^p", False 'Print
SendKeys "%y", False 'Print Style
SendKeys "tri", False
SendKeys "{Enter}", False
End Sub
Public Sub TaskFromMail()
    Dim cancel As Boolean
    If TypeName(Application.ActiveWindow) = "Inspector" Then
        Set item = Application.ActiveWindow.CurrentItem
        'MsgBox ("Subject : " & item.Subject)
        Call Application_ItemSend(item, cancel)
    End If
End Sub
Public Sub FindTask()
    If TypeName(Application.ActiveWindow) = "Inspector" Then
        Set item = Application.ActiveWindow.CurrentItem
        'MsgBox ("Subject : " & item.Subject)
        Call FindATask(item.Subject)
    End If
End Sub
Private Sub FindATask(pTaskName)
Dim NS  As Outlook.NameSpace
Dim TaskF   As Outlook.MAPIFolder
Dim Tasks   As Outlook.Items
Dim Task, FoundTask As Outlook.TaskItem
Dim shortTaskName As String
Set NS = Application.GetNamespace("MAPI")
Set TaskF = NS.GetDefaultFolder(olFolderTasks)
Set Tasks = TaskF.Items.Restrict("[Complete]=no")
If InStr(1, pTaskName, "RE:") = 1 Then
    shortTaskName = Mid(pTaskName, 5)
Else
    shortTaskName = pTaskName
End If
'MsgBox ("Searching For Task  : " & shortTaskName)
For Each Task In Tasks
    'MsgBox (Task.Subject & ":" & Task.Complete)
    If InStr(1, Task.Subject, shortTaskName) > 0 Then
        Set FoundTask = Task
        Exit For
    End If
Next
'MsgBox ("Search Finished : " & FoundTask.Subject)
FoundTask.Display
End Sub

The main sections are Private With Events and the Application_Startup to define and create the event handler. Then it’s over to the Application_ItemSend. Every time you send a message you get a message asking if you want to create a task. In my case the task name is a concatenation of the message recipient and the subject line. I also copy pertinent items from the mail message into the body of the task.

I have also the macro TaskFromMail which is not called automatically but on demand by myself for those cases where I have sent a mail from my Blackberry, or previously said I didn’t want a task and then I changed my mind.

I also have a macro that I run manually from a button in the email reading view to call the FindTask. This uses the current e-mail’s subject line to search for a task with a similar name.

Some other macros of note in the listing above:

  • CalItems_ItemAdd
    If someone sends me a meeting invite without a reminder – give me the option to add one.
  • MailItems_ItemAdd
    Automatically save email attachments to a folder in my hard disk.
  • printCalendar
    prints the calendar in tri-fold format. I originally wanted this to happen automatically on start up but I couldn’t get it to work so I just call it manually now.

35 replies on “Useful Outlook Macros”

Im trying to figure out how to setup the macros that you created. They seem very useful. Im not good in VB, so could you give me a little more guidance on how to get these macros setup in outlook. I have the developer toolbar and copy pasted the macros above into vb. Cant seem to figure out how to get it to work though. ANy help would be greatly appriciated.

Al

It is really difficult to try and troubleshoot this remotely.
Are you getting any error messages?
It could be a security problem – you may need to digitally sign the code and then tell outlook to “trust” your code.
You can double check this by temporarily setting your macro security to allow all macros to run.

Im a novice at programing and just dont know how to implement the code in VB. I opened up a window and copy pasted the code into the window and Im not sure what to do next. Im running 2010. If you could walk me through the steps, Id greatly appreciate it. Feel free to email me as well. Thanks!

Al

I’ll need to wait until I’m at work and have Outlook open in front of me but basically:
1) Private WithEvent ……
This creates some event handlers that we will use later
2) Private Sub Application_Startup()
This code runs automatically when Outlook starts – we are using it to initialise the event handlers, on for the inbox and one for the calendar.
3) Private Sub CalItems_ItemAdd
This code is attached to the Calendar event handler we created above and runs automatically whenever a new item is added to the calendar.
4) Private Sub MailItems_ItemAdd
This code is attached to the Inbox event handler we created above and runs automatically whenever a new item is added to the calendar.

I would really like to use this as well, but I feel like I need a step by step guide on where to go, with pictures. I have never messed with macros in any Microsoft program, and was looking for a simple start to optimize the software. Do you have a simple overview of this particular process I could see?

Thanks. Very useful, typically something that I have been looking for a long time. Works perfectly. …

While running the macro I observed that the date in item.SentOn would return 1/1/4501 for some reasons in the task body. I am a novice to scripting. I replaced this by “Now” which is essentially the same time the message is being sent. I was wondering why it would provide the date in this format. I tried Format(item.SentOn, “Short Date”), but with no success. 🙁

You are correct, I have since corrected this. It took me ages to work out that, at the point the macro is run the mail has not actually been sent so the sent on attribute is not set.
I’ll double check tomorrow my updated version and post it here.

Sorry to reply to a somewhat dead post. Thanks very much for this though. I’ve implemented on Outlook 2013. Very simple, and hard-coded some email addresses in to automatically select categories. I’m hoping this doesn’t turn into a sickness as I can see myself “tweaking” this to death. Thanks again. 🙂

What I am trying to do is create an calendar event from mail body as below.

If I receive any mail with message body as Due Date:01/01/2015 it should create a event in calendar and also alert me whenever that date and time occurs.

or other way I’m looking for a way (can be outlook add-in, or exchange add-in, or anything else), that will convert incoming mail messages to task items or calendar meetings in outlook.

Is this possible by rule or macro? Any help would be much appreciated.

Hi

First thank you so much for this – as a complete novice at macros I would never have been able to work this out and it is proving so useful.
A question if I may – how would I modify the macro that creates a task from an outgoing email so that it uses a customised task form that I have in my Personal Forms Library?
Regards
Ivor

Hi Ross,

Thank you for your codes. I think they are very helpful. You have a couple of macros that I’m trying to modify to fit my needs but without any success. So, I’m wondering if you could possibly help me out. What I’m trying to do is have a macro that looks at the email’s subject heading for a keyword, “SR” when I hit Send button. If it exists, prompt me with a message to create a Task (or automatically create it) with the same subject heading as the email’s and a due date 4-5 days from now. If a task with the same subject heading already exist, then either delete it and create a new one or update it with the new date. Right now, it keeps creating new Tasks every time I send the email with the same subject heading. The task search function when combined with the ItemSend does not work.

Private Sub MyMailItem_Send(Cancel As Boolean)
Dim olApp As Outlook.Application
Dim strSubject As String
Dim NS As Outlook.NameSpace
Dim TaskF As Outlook.MAPIFolder
Dim Tasks As Outlook.Items
Dim olTask, FoundTask As Outlook.TaskItem
Set NS = Application.GetNamespace(“MAPI”)
Set TaskF = NS.GetDefaultFolder(olFolderTasks)
Set Tasks = TaskF.Items.Restrict(“[Complete]=no”)

If InStr(MyMailItem.Subject, “SR”) > 0 Then
If MsgBox(“Create A Follow Up Task?”, vbYesNo) = vbYes Then
‘ If TypeName(Application.ActiveWindow) = “Inspector” Then
strSubject = “Follow Up: ” & MyMailItem.To & ” : About :” & MyMailItem.Subject
Set Item = Application.ActiveWindow.CurrentItem
For Each olTask In Tasks
If InStr(1, olTask.Subject, strSubject) > 0 Then
Set FoundTask = olTask
Exit For
End If
Next
MsgBox (“Search Finished : ” & FoundTask.Subject)
FoundTask.Delete

Set olTask = olApp.CreateItem(olTaskItem)
olTask.Subject = strSubject
olTask.Body = olTask.Body & MyMailItem.Body & vbCrLf
‘ olTask.Categories = Replace(MyMailItem.To, “,”, “-“)
olTask.DueDate = Date + 7
olTask.Status = olTaskWaiting
olTask.Display
olTask.Save
‘olTask.Close (olSave)
End If
‘ End If
End If
End Sub

My first suggestion would be to put a msgbox inside your task search loop to print out both the task name and the subject that you are searching on and visually compare to see if it is finding them – hopefully this will give you a clue as to where it is not working.

Hi,
Is this code formatted correctly for copy/paste?
I see what I think is HTML code at the beginning of each line….

Private Sub FindATask(pTaskName)
etc.

Is there an easy way to ‘unformat’ it to make copy/paste into VBA window easier?

Thanks,
Robert

Haha, the comment formatting stripped the HTML code I pasted from the code window…let’s see if this paste works…

[code starts here]Private Sub FindATask(pTaskName)

Apologies – I added a new plugin to make using the code easier to read and use.
Looks like in installing this it has pulled the formatting into the code.
I’ll have to manually edit each by hand …..
I’ll do this one at lunchtime today.

Just came across your outlook macros; they are brilliant one issue I am seeing is the date in followup task Sent: 1/1/4501 is there a fix?

For the “Create Follow-up Task”.. code trying to accomplish 2 things.

1. Attach any file attachments to the email into the task. I think the if statement can do this just not sure where to put into this macro

If Item.Attachments.Count > 0 Then
CopyAttachments Item, objTask
End If

2. Option to attach the entire email msg to the task using the following code but again — not sure where to place this in the macro..

Set newAttachment = objTask.Attachments
newAttachment.Add Item, olEmbeddeditem

Thanks again!!!

Found the problem with the date – at the point the macro is running the mail has not yet been sent so item.SentOn is not yet populated.
I have an update – just waiting on the code to be sent from my work machine.

RE: Attachments
I’d need to do some testing before recommending anything.

Any changes should be placed before the lines:
olTask.Display
olTask.Save

Tried the new code above and now getting a “compile syntax error” and it is point to the following code.

If Format(item.SentOn, “dd/mm/yyyy”) = “01/01/4501” Then
        dateSent = Now
Else
        dateSent = item.SentOn
End If

Try deleting the double quotes and re-adding them – I have seen this issue with other scripts where they become formatted as “pretty” quotes (different opening and closing).
I was hoping that the new add-in I’m using to hold my code would resolve this.

Glad I can be of help – I’ll have a look at your attachment question but I have another macro (surprise surprise) which searches for the e-mail that generated the task. Personally I don’t like having more than one physical copy of the mail or attachments floating around.

Struggling with trying to convert these scripts you developed to include embedding the original email and attachments into the tasks.. I am a very basic vb skill if you can even call skill but trying to google around and hack something together is not getting me much — you have any insights.. ?

Hi Ross, thanks again for a very cool set of macros….

I have been using the task creation on send macro for some time, but I think I would prefer to just have a request I want to save a copy to a folder (waiting for, for example)…and then use the conversation view for the email to see if there was follow-up/responses.

Is there a way to update your technique to do that?
On send, pop-up windows asks “Save a copy to Waiting For?”, yes/no….
If yes, save a copy of the email to Waiting For
If no, save to default folder (although I use SimplyFile to file outgoing emails….).

Any ideas/help/pointers?

Hi Ross,

Could you please share some examples of macros used in MS Outlook 2010.

Pooja

Hi Ross,

I am stuck trying to figure out where these different sections of code should be saved. To override appliction_startup that sub must be saved in ThisOutlookSession correct? But I believe the private withevents section must be saved within a class module which put them out of scope from where application_startup is saved.

Would really appreciate any clarification, I am new to VBA for outlook.

Thanks,

Rory

Hi,
Thanks for the codes and sharing.
I have copied and pasted the code above but still gettin Syntax Error for the If Format(item.SentOn, “dd/mm/yyyy”) = “01/01/4501” Then line… I couldnt resolve the problem. Any idea?
Regards,

Leave a Reply

Your email address will not be published. Required fields are marked *