Last reviewed on October 3, 2012   —  No Comments

Applies to: Microsoft Outlook 2013, Outlook 2010, and Outlook 2007

A popular request is the ability to assign a Outlook account to a contact, so every time you send a message to that contact, Outlook uses the desired account automatically. Although Outlook doesn't have this feature, you can use VBA to pick the account that will be used to send the message.

Don't want to use VBA? See Tools for third party utilities. The utilities will work with older versions of Outlook.

This code sample checks the category assigned to a contact and picks the sending email account based on the category. Assign the macro to a toolbar, QAT, or ribbon command and use in place of the New button. You can configure the macro to either tell you that you do not have a contact selected or select the default account when either a category matching an account is not found or you are in a folder other that Contacts.

In this iteration, it requires only 1 category per contact. For it to work with Contacts with more than one category assigned, you need to parse the Categories string, looking for the right keyword name. That is more work than this lazy programmer does. :)

The display name for the Account is is Account SettingsAssign the account display name as it appears in Account Settings as the category. In Outlook 2010, this is usually the email address but it can be changed to a friendly name (double click on the account, then More Settings).

This code checks the category and links it to an account. If no match is found, it uses default account. Note: This uses the *default* account as set in Account Settings, not the account assigned to the current folder in Outlook 2010.

Choose Account based on Contact Category

To use: Press Alt+F11 to open the VBA Editor. You can paste this into ThisOutlookSession or insert a new module.

Select a contact and run the macro.

Public Sub AccountByContact()
Dim oAccount As Outlook.Account
Dim oContact As Outlook.ContactItem
Dim strAccount As String
Dim olNS As Outlook.NameSpace
Dim objMsg As MailItem

Set olNS = Application.GetNamespace("MAPI")
Set objMsg = Application.CreateItem(olMailItem)

If TypeName(ActiveExplorer.Selection.Item(1)) = "ContactItem" Then
 Set oContact = ActiveExplorer.Selection.Item(1)
 On Error Resume Next
 strAccount = oContact.Categories
 For Each oAccount In Application.Session.Accounts
  If oAccount.DisplayName = strAccount Then
     objMsg.SendUsingAccount = oAccount
     objMsg.SendUsingAccount = olNS.Accounts.Item(1)
  End If

  objMsg.To = (oContact.Email1Address)

Set objMsg = Nothing
Set olNS = Nothing

' Either tell user the selection is not a contact 
'MsgBox "Sorry, you need to select a contact"
' Or open a new message using the default account

End If

End Sub


SendGuard 4Outlook

Send Guard will detect and prompt you whenever you make any of these mistakes and more: forget to send an attachment you promised in a message, Reply-to-All or forget to Reply-to-All, send emails using the wrong email account, send emails with blank or incorrect subjects, said something you oh-so-knew-better than to say.

Leave a Reply

Please post long or more complicated questions at OutlookForums by

If the Post Comment button disappears, press your Tab key.