Можно ли алфавитировать список приглашенных в приглашении на собрание в Outlook?

Question

У меня есть приглашение на собрание Outlook с более чем 40 людьми, но в поле « To: на вкладке «Встреча» и на вкладке « Scheduling Assistant по планированию » люди отображаются в том порядке, в котором они были добавлены, а не в алфавитном порядке.

Это затрудняет сканирование списка, чтобы увидеть, находится ли данный человек в нем.

Есть ли способ алфавитизировать список людей, которые были приглашены на данную встречу?

Answer 1

С некоторым 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