Outlook Macros for Getting Things Done in Outlook

Hey All,1001004005752454

This blog post is in English because that is the language people use to find code snippets.

I just recreated the three scripts I use to automate my GTD discipline in Outlook 2007 and because this was the second time I actually created these scripts I figured it is a good idea to document them somehwhere.

Script 1: Create a task with the selected e-mail as attachment.

Sub CreateTask()

Dim olTask As Outlook.TaskItem
'Using object rather than MailItem, so that it
'can handle posts, meeting requests, etc as well
Dim olItem As Object
Dim olExp As Outlook.Explorer
Dim fldCurrent As Outlook.MAPIFolder
Dim olApp As Outlook.Application

Set olApp = Outlook.CreateObject("Outlook.Application")
Set olTask = olApp.CreateItem(olTaskItem)
Set olExp = olApp.ActiveExplorer
Set fldCurrent = olExp.CurrentFolder

Dim cntSelection As Integer
cntSelection = olExp.Selection.Count

For i = 1 To cntSelection
Set olItem = olExp.Selection.Item(i)
olTask.Attachments.Add olItem
olTask.Subject = olItem.Subject
If Not fldCurrent = "_Archive" Then
If olItem.Class = olMail Then
olItem.UnRead = False
End If
olItem.Move Session.GetDefaultFolder(olFolderInbox).Folders("_Archive")
End If
Next

olTask.Display
'Set the due date for today
olTask.DueDate = Date
'Set the reminder for 3 hours from now
olTask.ReminderSet = True
olTask.ReminderTime = DateAdd("h", 3, Now)

'Saving the task item, so that in case I close it, I won't lose
'the items which were deleted after being attached to the task
olTask.Save

End Sub

Script 2: Moving the selected mail to your _Archive folder.

[vb]

Sub Archive()

Dim olTask As Outlook.TaskItem
‘Using object rather than MailItem, so that it
‘can handle posts, meeting requests, etc as well
Dim olItem As Object
Dim olExp As Outlook.Explorer
Dim fldCurrent As Outlook.MAPIFolder
Dim olApp As Outlook.Application

Set olApp = Outlook.CreateObject("Outlook.Application")
Set olTask = olApp.CreateItem(olTaskItem)
Set olExp = olApp.ActiveExplorer
Set fldCurrent = olExp.CurrentFolder

Dim cntSelection As Integer
cntSelection = olExp.Selection.Count

For i = 1 To cntSelection
Set olItem = olExp.Selection.Item(i)
If Not fldCurrent = "_Archive" Then
If olItem.Class = olMail Then
olItem.UnRead = False
End If
olItem.Move Session.GetDefaultFolder(olFolderInbox).Folders("_Archive")
End If
Next

End Sub
[/vb]

Script 3: Check the subject of send items for [w] and copy them to the Waiting for folder

This script must be located in the ThisOutlookSession

[vb]<em>
</em></pre>
‘Place in ThisOutlookSession
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim copItem As MailItem
If Item.Class = olMail Then
If InStr(1, Item.Subject, "[w]") Then
Item.Subject = Replace(Item.Subject, "[w]", "")
Set copItem = Item.Copy
copItem.Move Session.GetDefaultFolder(olFolderInbox).Folders("Waiting for")
End If
End If
End Sub

[/vb]

There are some tricks that are usefull if you go this route.
1. Add buttons and shortkeys to these marcros
http://www.techrepublic.com/blog/howdoi/how-do-i-create-custom-toolbar-buttons-in-outlook/146 – Start at figure C
2. Macro Security and certificates
http://www.howto-outlook.com/howto/selfcert.htm

For these Macros to work you need the following folder structure.

Inbox
– _Archive
– Waiting for

Enjoy these Macros

Posted: December 28th, 2012
Categories: Uncategorized
Tags:
Comments: No Comments.