Updated Outlook Recipients Collection code

In Use the Recipients collection to add recipients to emails I promised to update the code found at Working with the Outlook Recipients collection in VBA. This article is intended to provide code that fully replaces the methods found on that page.

One of the first things I noticed was the code that checks if an item has a Recipients Collection. This code appears in nearly every function! It needs to be in its own function.

Has Recipients?

The following function checks if a given item has a Recipients Collection:

Function HasRecipientCollection(itm As Variant) As Boolean
  Dim types As Variant
  ' only these Outlook items have a Recipients Collection
  ' tokenize string into array elements
  types = Split("MailItem,AppointmentItem,JournalItem,MeetingItem,TaskItem", ",")
  HasRecipientCollection = (UBound(Filter(types, TypeName(itm))) > -1)
End Function

We can modularize this even further by using the StringToArray function:

Function HasRecipientCollection(itm As Variant) As Boolean
  Dim types As Variant
  ' only these Outlook items have a Recipients Collection
  types = StringToArray("MailItem,AppointmentItem,JournalItem,MeetingItem,TaskItem", ",")
  HasRecipientCollection = (UBound(Filter(types, TypeName(itm))) > -1)
End Function

If this function returns
true

then the given item has a Recipients Collection which we can work with further. The following procedure can be used to test the function:

Sub TestHasRecip()
  Dim msg As Outlook.mailItem
  ' create or get a mailitem however you choose ...
  Set msg = Outlook.CreateItem(olMailItem)
  Debug.Print HasRecipientCollection(msg)
End Sub

Adding Recipients

The code for adding recipients does not allow for any means to specify the recipient Type. We should rectify that by adding an additional parameter to the original function.

recipType is a new parameter and is dependent on the item type. See the documentation for the Type Property for possible values.

Function AddToRecipients(ByRef itm As Variant, nameToAdd As String, _
    recipType As Long) As Outlook.Recipient
' pass in a name or email
  Set AddToRecipients = itm.Recipients.Add(nameToAdd)
  If Not ResolveRecipients(recips) Then
    Set AddToRecipients = Nothing
    Exit Function
  End If
  AddToRecipients.Type = recipType
End Function

The function does not verify whether the recipType value is appropriate for the type of item being updated. (We'll look at that in a future post.) It assumes that the item is not a Recipients Object itself but is instead an object that has a Recipients Collection (use the HasRecipientCollection function to check that first). In other words, you would pass in a MailItem, not a MailItem.Recipients Object. You would also pass in a name (that resolves in the address book) or an email address (which always resolves).

Getting Recipients

The code for returning Recipient objects currently requires that you specify the index number of the recipient. This means you would have to iterate through the Recipients Collection to get the index of the recipient you want, then run this code to return a Recipient Object. This is especially wasteful if you already know the name and have to iterate through the collection just to get the index number.

The updated code lets you specify an index number (if you happen to already know it) or a name. It simply attempts to blindly reference the named (or numbered) recipient. To verify that the function successfully returned a Recipient Object, check that the result is not equal to Nothing.

Function GetRecipientItem(itm As Object, indexOrName As Variant) As Outlook.Recipient
  On Error Resume Next
  Set GetRecipientItem = itm.Recipients.Item(indexOrName)
End Function

Instead of looping, we can simply use

On Error Resume Next
Set GetRecipientItem = recips.Item(indexOrName)

which shortens the code significantly. According to the VBA help documentation, the Index value can be either the index number of the object, or a value used to match the default property of an object in the collection.

Remember that you need to call the HasRecipientCollection function on any given item before passing it to this function.

Ex:

Sub TestGetRecip()
  Dim itm As Object
  Dim i As Long
  Dim recip As Outlook.Recipient

  ' grab currently selected item
  Set itm = Outlook.ActiveExplorer.Selection.Item(1)
  If HasRecipientCollection(itm) Then
    ' loop through and print each recipient's display name
    For i = 1 To itm.Recipients.Count
      Set recip = GetRecipientItem(itm, i)
      If Not recip Is Nothing Then
        Debug.Print recip.Name
      End If
    Next i
  End If
End Sub

Removing Recipients

The code to remove recipients from the Recipients Collection of a given object also requires that you specify the index number of the recipient you want to remove. We can easily change that so we can specify either the index or the name. Again, since the default property of a Recipient Object is the Name Property, we can pass in a name or an index number, if we happen to know it.

Function RemoveRecipientItem(itm As Variant, indexOrName As Variant)
  On Error Resume Next
  itm.Recipients.Item(indexOrName).Delete
End Function

We can use this code as part of a loop:

Sub TestRemove()

Dim itm As Object
Dim recips As Outlook.Recipients
Dim i As Long

  ' grab currently selected item
  Set itm = Outlook.ActiveExplorer.Selection.Item(1)
  If HasRecipientCollection(itm) Then
    For i = itm.Recipients.Count To 1 Step -1
      RemoveRecipientItem itm, i
    Next i
  End If
End Sub

In a future post we'll explore the Type property and how we can make our functions more intelligent in that regard.