Working with the Outlook Recipients collection in VBA

The Recipients collection is just one of many collections in VBA for Outlook. But as it represents the list of names of people who will receive your message, it's important that you have methods for working with it.

Why should we care about the Recipients Collection? After all, can't I just write this instead?

Sub TestMessage()
Dim Msg As Outlook.MailItem
  Set Msg = Outlook.CreateItem(olMailItem)
  With Msg
    .To = "you"
    .CC = "my friend"
  End With
End Sub

First of all, it's a more robust interface. Second, it's the preferred method according to MSDN. About the To Property, it states:

Returns or sets a semicolon-delimited String list of display names for the To recipients for the Outlook item. This property contains the display names only. The To property corresponds to the MAPI property PR_DISPLAY_TO. The Recipients collection should be used to modify this property.

You'll see the same sort of thing if you look at the BCC and CC properties. They're intended to be read, not written.

So when we want to change or set Recipients, we should

• Use Recipients.Count to get a count of recipients
• Use Recipients.Add to add a recipient
• Use Recipients.Remove to delete a recipient
• Use Recipients.ResolveAll to resolve recipients against the Address Book or GAL
• Use Recipient.Type to set the type of Recipient (BCC, CC or To)

And shame on me for not doing it this way consistently!

Return Recipients Collection For a Mail Item

There are times when we just want to work with the Recipients Collection for emails. In this case, the following function should suffice:

Function GetMailRecipients(msg As Outlook.MailItem) As Outlook.Recipients
  Set GetMailRecipients = msg.Recipients
End Function

To make our function work with all possible objects, we should be able to return the Recipients Collection for any qualifying item. The following items have a Recipients Collection:

• MailItem
• AppointmentItem
• JournalItem
• MeetingItem
• TaskItem

Pass any of these to the following function and you'll end up with its Recipients Collection.

Function GetRecipients(itm As Object) As Outlook.Recipients
Dim obj As Object
Dim recips As Outlook.Recipients
Dim types() As String

  types = Split("MailItem,AppointmentItem,JournalItem,MeetingItem,TaskItem", ",")

  If UBound(Filter(types, TypeName(itm))) > -1 Then  ' it's a matching item
    Set obj = itm
    Set recips = obj.Recipients
    Set GetRecipients = recips
  End If

End Function

Count Recipients

Here's a unique way of getting the Recipients.Count value by either passing a Recipients Collection or a qualifying item to a function.

Function GetRecipientsCount(itm As Variant) As Long
' pass in a qualifying item, or a Recipients Collection
Dim obj As Object
Dim recips As Outlook.Recipients
Dim types() As String

  types = Split("MailItem,AppointmentItem,JournalItem,MeetingItem,TaskItem", ",")

  Select Case True
      ' these items have a Recipients collection
    Case UBound(Filter(types, TypeName(itm))) > -1
      Set obj = itm
      Set recips = obj.Recipients
    Case TypeName(itm) = "Recipients"
      Set recips = itm
  End Select

  GetRecipientsCount = recips.Count

End Function

Add a Recipient

This code uses the same approach as the code above. You can pass in either a Recipients Collection (if you already have it), or a qualifying item, and it will add to the Recipients Collection for that object. It attempts to resolve the Recipients collection using a function found below.

Function AddToRecipients(ByRef itm As Variant, nameToAdd As String) As Outlook.Recipient
' pass in a qualifying item, or a Recipients Collection
Dim obj As Object
Dim recips As Outlook.Recipients
Dim types() As String

  types = Split("MailItem,AppointmentItem,JournalItem,MeetingItem,TaskItem", ",")

  Select Case True
      ' these items have a Recipients collection
    Case UBound(Filter(types, TypeName(itm))) > -1
      Set obj = itm
      Set recips = obj.Recipients
    Case TypeName(itm) = "Recipients"
      Set recips = itm
  End Select

  Set AddToRecipients = recips.Add(nameToAdd)

  If Not ResolveRecipients(recips) Then
    Set AddToRecipients = Nothing
  End If

End Function

Grab a specific Recipient

This function returns a specific Recipient back to the calling procedure.

Function GetRecipientItem(itm As Variant, index As Variant) As Outlook.Recipient
' pass in a qualifying item, or a Recipients Collection
Dim obj As Object
Dim recips As Outlook.Recipients
Dim types() As String

  types = Split("MailItem,AppointmentItem,JournalItem,MeetingItem,TaskItem", ",")

  Select Case True
      ' these items have a Recipients collection
    Case UBound(Filter(types, TypeName(itm))) > -1
      Set obj = itm
      Set recips = obj.Recipients
    Case TypeName(itm) = "Recipients"
      Set recips = itm
  End Select

  Set GetRecipientItem = recips.Item(index)

End Function

This function is perfect for iterating through a Recipients Collection. For example, if you wanted to change a property for each recipient to an email.

First get the Recipients.Count and use that as the upper bound of a For loop. Then assign each Recipient to its own object and do what you need to with it.

Dim i As Long
Dim recip As Outlook.Recipient
For i = 1 To GetRecipientsCount(msg)
  Set recip = GetRecipientItem(msg, i)

  recip.Resolve
Next i

Remove Recipients

Recipients.Remove(index) is used to remove someone from the Recipients Collection.

Function RemoveRecipientItem(itm As Variant, index As Long)
' pass in a qualifying item, or a Recipients Collection
Dim obj As Object
Dim recips As Outlook.Recipients
Dim types() As String

  types = Split("MailItem,AppointmentItem,JournalItem,MeetingItem,TaskItem", ",")

  Select Case True
      ' these items have a Recipients collection
    Case UBound(Filter(types, TypeName(itm))) > -1
      Set obj = itm
      Set recips = obj.Recipients
    Case TypeName(itm) = "Recipients"
      Set recips = itm
  End Select

  recips.Remove index

End Function

Resolve Recipients

Resolving recipients means matching each one against the Address Book or the GAL. If there is a single match on the name, or if you use a Internet-style address (ex: name@address.com), the recipient will resolve.

Function ResolveRecipients(itm As Variant) As Boolean
' pass in a qualifying item, or a Recipients Collection
Dim obj As Object
Dim recips As Outlook.Recipients
Dim types() As String

  types = Split("MailItem,AppointmentItem,JournalItem,MeetingItem,TaskItem", ",")

  Select Case True
      ' these items have a Recipients collection
    Case UBound(Filter(types, TypeName(itm))) > -1
      Set obj = itm
      Set recips = obj.Recipients
    Case TypeName(itm) = "Recipients"
      Set recips = itm
  End Select

  ResolveRecipients = recips.ResolveAll

End Function

This function will return False if the recipients don't resolve, but you won't know which one. You can edit the function to determine which one didn't, but I'll use a separate loop instead.

Dim i As Long
Dim recip As Outlook.Recipient
For i = 1 To GetRecipientsCount(msg)
  Set recip = GetRecipientItem(msg, i)

  If Not recip.Resolve Then
    MsgBox recip.Name " did not resolve."
  End If
Next i

Sample usage

This procedure will show you how the functions above can be used with either an existing Recipients Collection (if you've already got an object reference) or an item that supports a Recipients Collection.

Select or open an email and run this procedure. It grabs the currently selected or open message and checks the recipient count using both methods. The same number should appear twice in the Immediate Window.

Sub TestGetRecipients()

Dim msg As Outlook.MailItem
Dim recips As Outlook.Recipients

  Set msg = GetMailItem
  Set recips = msg.Recipients

  Debug.Print GetRecipientsCount(msg)
  Debug.Print GetRecipientsCount(recips)

End Sub

Function GetMailItem() As Outlook.MailItem

  On Error Resume Next

  Select Case TypeName(Application.ActiveWindow)
    Case "Explorer"

      If TypeName(ActiveExplorer.Selection.Item(1)) = "MailItem" Then
        Set GetMailItem = ActiveExplorer.Selection.Item(1)
      End If

    Case "Inspector"

      If TypeName(ActiveInspector.currentItem) = "MailItem" Then
        Set GetMailItem = ActiveInspector.currentItem
      End If
  End Select
  On Error GoTo 0
End Function

Related Articles:

• January 31, 2011 -- Add photos to Contacts in bulk using VBA in Outlook
• July 20, 2010 -- Delete duplicate contacts in Outlook using VBA
• March 3, 2010 -- Add and return Excel.Worksheet references in VBA