VBA Outlookの連絡先のリストボックスを並べ替える

Question

2列のリストボックスに私のOutlookの連絡先フォルダの内容を入力し、その情報をクリック時にテキストボックスに送信できました...悲しいかな、リストボックスを並べ替えるにはどうすればいいですか？

Private Sub getOutlookContacts() 
Dim i As Integer 
Dim oOutlookApp As Outlook.Application 
Dim oOutlookNameSpace As Outlook.NameSpace 
Dim oContacts As Outlook.MAPIFolder 
Dim oContact As Outlook.ContactItem 

    On Error Resume Next 

    Set oOutlookApp = GetObject(, "Outlook.Application") 
    If Err <> 0 Then 
    Set oOutlookApp = CreateObject("Outlook.Application") 
    End If 

    Set oOutlookNameSpace = oOutlookApp.GetNamespace("MAPI") 
    'Get the contactfolder 
    Set oContacts = oOutlookNameSpace.GetDefaultFolder(olFolderContacts) 

    Set oContact = oContacts.Items 
    'oContacts.Sort "[FullName]", False, olAscending 
    For Each oContact In oContacts.Items 
    Me.ListBox1.AddItem oContact.FullName 
    Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = oContact.BusinessAddress 
    i = i + 1 
    Next 

    Set oContact = Nothing 
    Set oContacts = Nothing 
    Set oOutlookNameSpace = Nothing 
    Set oOutlookApp = Nothing 

End Sub 

Answer 1

あなたはソート機能が組み込まれて（例えば）としてを使用することができます。

oContacts.Items.Sort "[FullName]", False 
Set oContact = oContacts.Items.GetFirst 
Do 
    ' Add oContact details to the listbox 
    Set oContact = oContacts.Items.GetNext 
Loop Until oContact Is Nothing 

これが最も可能性が高い速くなるだろう、ではないに言及自分でリストを並べ替えるよりも簡単です...

Answer 2

Private Sub getOutlookContacts() 
    Dim i As Integer 
    Dim oOutlookApp As Outlook.Application 
    Dim oOutlookNameSpace As Outlook.NameSpace 
    Dim oContacts As Outlook.MAPIFolder 
    Dim oContact As Outlook.ContactItem 
    Dim vaContacts As Variant 

    On Error Resume Next 

    Set oOutlookApp = New Outlook.Application 

    Set oOutlookNameSpace = oOutlookApp.GetNamespace("MAPI") 
    'Get the contactfolder 
    Set oContacts = oOutlookNameSpace.GetDefaultFolder(olFolderContacts) 

    Set oContact = oContacts.Items 
    ReDim vaContacts(0 To oContacts.Items.Count - 1, 0 To 1) 

    'oContacts.Sort "[FullName]", False, olAscending 
    For Each oContact In oContacts.Items 
     vaContacts(i, 0) = oContact.FullName 
     vaContacts(i, 1) = oContact.BusinessAddress 
     i = i + 1 
    Next oContact 

    SortArray vaContacts 

    Me.ListBox1.Clear 
    Me.ListBox1.List = vaContacts 

    Set oContact = Nothing 
    Set oContacts = Nothing 
    Set oOutlookNameSpace = Nothing 
    Set oOutlookApp = Nothing 

End Sub 

Private Sub SortArray(ByRef vaArray As Variant) 

    Dim i As Long 
    Dim j As Long 
    Dim sTemp As String 
    Dim sTemp2 As String 

    'Bubble sort the array on the first value 
    For i = LBound(vaArray, 1) To UBound(vaArray, 1) - 1 
     For j = i + 1 To UBound(vaArray, 1) 
      If vaArray(i, 0) > vaArray(j, 0) Then 
       'Swap the first value 
       sTemp = vaArray(i, 0) 
       vaArray(i, 0) = vaArray(j, 0) 
       vaArray(j, 0) = sTemp 

       'Swap the second value 
       sTemp2 = vaArray(i, 1) 
       vaArray(i, 1) = vaArray(j, 1) 
       vaArray(j, 1) = sTemp2 
      End If 
     Next j 
    Next i 

End Sub 

も参照してくださいhttp://www.dailydoseofexcel.com/archives/2004/05/24/sorting-a-multicolumn-listbox/