☰

有没有办法按字母顺序排列 Outlook 会议邀请中的受邀者名单？

tag-icon • tag-icon microsoft-outlook
有没有办法按字母顺序排列 Outlook 会议邀请中的受邀者名单？

我收到一份 Outlook 会议邀请，上面有 40 多人的参与，但是在To:约会选项卡字段中以及选项Scheduling Assistant卡上，人员按照添加的顺序显示，而不是按字母顺序显示。

这使得浏览列表以查看某个人是否已经在列表中变得很困难。

有没有办法按字母顺序排列受邀参加特定会议的人员名单？

答案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

相关内容