Take the 2-minute tour ×
Super User is a question and answer site for computer enthusiasts and power users. It's 100% free, no registration required.

I have an Outlook meeting invite with over 40 people on it, but in the To: field of the appointment tab and on the Scheduling Assistant tab people show up in the order they were added, not alphabetically.

This makes it difficult to scan the list to see if a given person is already on it.

Is there a way to alphabetize the list of people who have been invited to a given meeting?

share|improve this question
add comment

1 Answer

up vote 1 down vote accepted

With some VBA

Sub Recipients_AppointmentItem()

Dim olAppt As Object
Dim objRecipient As Outlook.Recipient

ReDim namesto(0 To 5) As Variant

Dim I As Long
Dim msg As String

On Error Resume Next

If ActiveInspector.currentItem.Class = olAppointment Then
    Set olAppt = ActiveInspector.currentItem
End If

If olAppt Is Nothing Then
' Might be in the explorer window
    If (ActiveExplorer.selection.Count = 1) And _
      (ActiveExplorer.selection.Item(1).Class = olAppointment) Then
        Set olAppt = ActiveExplorer.selection.Item(1)
    End If
End If

On Error GoTo 0

If olAppt Is Nothing Then
    MsgBox "Problem." & vbCr & vbCr & "Try again " & _
      "under one of the following conditions:" & vbCr & _
      "-- You are viewing a single appointment." & vbCr & _
      "-- You have only one appointment selected.", _
    vbInformation
    Exit Sub
End If

If olAppt.Recipients.Count > 5 Then
ReDim namesto(0 To olAppt.Recipients.Count)
End If

I = 1
For Each objRecipient In olAppt.Recipients
    If objRecipient = olAppt.Organizer Then
        namesto(I) = objRecipient & " - Organizer"
    Else
        namesto(I) = objRecipient
    End If

    I = I + 1

Next objRecipient

Call BubbleSort(namesto())

For I = 1 To olAppt.Recipients.Count

If namesto(I) = olAppt.Organizer Then
    namesto(I) = namesto(I) & " - Organizer"
End If

msg = msg & I & " - " & namesto(I) & vbCr

Next I

CreateMail "List of Recipients as of " & Now, msg

exitRoutine:
    Set olAppt = Nothing

End Sub


Function CreateMail(fSubject, fMsg)
' Creates a new e-mail item

Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem

Set olApp = Outlook.Application

' Create e-mail item
Set objMail = olApp.CreateItem(olMailItem)

With objMail
   .Subject = fSubject
   .Body = fMsg
   .Display
End With

Set olApp = Nothing
Set objMail = Nothing

End Function


Sub BubbleSort(MyArray() As Variant)
'
' http://www.vbaexpress.com/kb/getarticle.php?kb_id=103
'
Dim First           As Integer
Dim Last            As Integer
Dim I               As Integer
Dim j               As Integer
Dim Temp            As String

First = LBound(MyArray) + 1
Last = UBound(MyArray)
For I = First To Last - 1
    For j = I + 1 To Last
        If MyArray(I) > MyArray(j) Then
            Temp = MyArray(j)
            MyArray(j) = MyArray(I)
            MyArray(I) = Temp
        End If
    Next j
Next I

End Sub
share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.