VBA Outlook 연락처의 목록 상자 정렬

Question

2 열 목록 상자에 내 Outlook 연락처 폴더의 내용을 채우고 해당 정보를 클릭하여 텍스트 상자로 보낼 수 있습니다 ... 아아, 목록 상자를 정렬하려면 어떻게해야합니까?

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 

이 가장 가능성 언급, 빠를하지 않는 것입니다 :

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

당신은 (예를 들어)로 분류 기능 내장 사용할 수 있습니다 목록을 직접 정렬하는 것보다 쉽습니다 ...

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/는

는