I've recently been having problems with a sore left wrist (not my mouse hand, my Ctrl+C,Ctrl+V hand) and have been assessing what some of my recurrent activities are.
Madgex have bought an
ergonmic keyboard for me to use, and have had the lovely people from
Posture People in to assess my workstation/posture (my monitors were too far away, my mouse wasn't in the right place, my seat wasn't supporting me properly and I wasn't sitting correctly (think of a seated
tadasana)). My new keyboard comes with the concept of Favourites, i.e. quick launch buttons to start frequently used applications. This is a good idea, and got me thinking about other recurrent activities that I could program either a button, or a macro to do.
One of my regular activities, as
I've mentioned before, is forwarding emails to toodledo for adding to my task list for tomorrow. I do this by sending the email to a unique address, and editing the subject line to include:
@@work - i.e. give the task the context of @work
#tomorrow - i.e. give the task a due date of tomorrow
*Actioned - i.e. put the task in the folder named Actioned
I then move the email to a subfolder of my Inbox named Actions
I figured that I could write a macro to do this, so with a bit of help from
here and
there, I got the following macro working. I've named the project "SendTo", so the macro is called as "SendTo.Toodledo" and I've added a shortcut to my menu bar to this macro. It works on a single email at a time, which suits my process - I try and read the email before deciding whether it needs to be actioned or just filing straight away.
Sub Toodledo()
'Forward the selected email to Toodledo, updating the subject with the appropriate shortcuts and move to appropriate folder
On Error Resume Next Dim objMail As Outlook.MailItem
Dim objItem As Outlook.MailItem Set objItem = GetCurrentItem()
Set objMail = objItem.Forward objMail.To = "<toodledo email address goes here>" 'my toodledo email address
objMail.Subject = "Respond to " + objMail.Subject + " @@work #tomorrow *Actioned" 'Prefix with Respond to, and append context of @work, date of tomorrow, and folder of Actioned
objMail.Send Call MoveMessageToFolder(objItem, "Actions") 'move it to my Actions folder 'clean up
Set objMail = Nothing
Set objItem = NothingEnd SubPrivate Function GetCurrentItem() As Outlook.MailItem
'Taken from code sample provided at http://www.pcreview.co.uk/forums/thread-2798274.php
On Error Resume Next 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 'clean up
Set objApp = Nothing
End FunctionPrivate Sub MoveMessageToFolder(objItem As Outlook.MailItem, ByVal sFolder As String)
'Loosely based on code found at http://verychewy.com/archive/2006/04/12/outlook-macro-to-move-an-email-to-fol...
On Error Resume Next Dim objFolder As Outlook.MAPIFolder
Dim objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Folders(sFolder) If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
End If objItem.Move objFolder 'Clean up
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End SubThere isn't anything very clever going on here, but having written it, it may just help someone else.
Note: I then had to
sign my macro to ensure that this started successfully without warnings on subsequent starts of outlook
(which is very good by the way) by Jason Fried, David Heinemeier Hansson and used the 
