Skip to content

Instantly share code, notes, and snippets.

@jflam
Last active January 27, 2016 17:13
Show Gist options
  • Save jflam/ea038885ad23cd20cbcf to your computer and use it in GitHub Desktop.
Save jflam/ea038885ad23cd20cbcf to your computer and use it in GitHub Desktop.
Use quick access toolbar in Outlook to accelerate mail handling via ALT-1, ALT-2 etc. keybindings.
' How to setup this macro:
'
' Assumes you have 3 folders setup called Archives, Followup P1 and Followup P2
' To setup key bindings:
' 1. Hit ALT-F11 to open the VBA Window
' 2. Right-click on Project1 and select Insert/New Module
' 3. Paste this gist into the Module and save
' 4. Right-click on the top-most toolbar in VS (above the File/Home/Send ... menu) - this is called the Quick Access Toolbar
' 5. The Outlook Options dialog appears. On the Choose commands from: dropdown, select Macros. You'll see your macros there.
' 6. Add the macros to the toolbar by clicking on the Add >> button. The first macro on the list is bound to ALT-1, second ALT-2 etc.
' 7. Select each macro you added to the toolbar and enter its name and an icon that you can remember. This isn't strictly
' needed as you'll almost always invoke these macros using the ALT-n keybindings.
' 8. You'll need to enable all macros to run in Outlook in Trust center. Get there by File / Options. Click on Trust Center.
' Click on Trust Center Settings. Click on Macro Settings. Click on Enable all macros.
' OR create a self-signed cert for VBA projects - see http://www.groovypost.com/howto/howto/office-2010-outlook-self-signed-digital-certificate/
Enum ItemOptions
MarkAsRead
MarkAsUnread
MarkAsTaskForToday
MarkAsTaskForWeek
End Enum
' Helper function that moves selected mail (i.e., you can move multiple mails with single keystroke) to a named folder
Private Sub MoveToFolder(folder As String, options As ItemOptions)
On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Folders(folder)
If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
End If
If Application.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is selected
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
If options = MarkAsRead Then
objItem.UnRead = False
End If
If options = MarkAsTaskForToday Then
objItem.MarkAsTask olMarkToday
ElseIf options = MarkAsTaskForWeek Then
objItem.MarkAsTask olMarkThisWeek
End If
objItem.Move objFolder
End If
End If
Next
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub
Sub MoveSelectedMessagesToArchive()
MoveToFolder "Archives", MarkAsRead
End Sub
Sub MoveSelectedMessagesToFollowUp()
MoveToFolder "FollowUp", MarkAsTaskForToday
End Sub
Sub MoveSelectedMessagesToFollowUpP2()
MoveToFolder "FollowUpP2", MarkAsTaskForWeek
End Sub
Sub ReplyAsPlainText()
Dim app As New Outlook.Application
Dim exp As Outlook.Explorer
Set exp = app.ActiveExplorer
Dim item As Outlook.MailItem
Set item = exp.Selection.item(1)
item.BodyFormat = olFormatPlain
item.Actions("Reply").ReplyStyle = olReplyTickOriginalText
Dim reply As Outlook.MailItem
Set reply = item.Actions("Reply").Execute
reply.Save
reply.Display
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment