Existe uma maneira de alfabetizar a lista de convidados em um convite de reunião do Outlook?

Question

Eu tenho um convite para a reunião do Outlook com mais de 40 pessoas, mas no campo To: da guia de compromissos e na guia Scheduling Assistant , as pessoas aparecem na ordem em que foram adicionadas, não alfabeticamente.

Isso dificulta a varredura da lista para ver se uma determinada pessoa já está nela.

Existe uma maneira de alfabetizar a lista de pessoas que foram convidadas para uma determinada reunião?

    

Answer 1

Com algum 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