The following updated code sorts the combobox named ddlCategories

Can anyone show me what to change/add to sort the comobox named ddl.Contacts as it only sorts the contacts alphabetically from each folder he contacts come from.


Private Sub ddlCategories_Change()
Dim objOutlook As outlook.Application
Dim objNS As outlook.NameSpace
Dim objFolder As outlook.MAPIFolder
Dim ctc As ContactItem
Dim FolderName As String
Dim fldr As folder
Dim flder As outlook.folder
Dim flderr As outlook.folder
Dim myContacts As outlook.items
Dim Category As String

Category = Me.ddlCategories.Text

Set objOutlook = CreateObject("Outlook.Application")
Set objFolder = objOutlook.Session.GetDefaultFolder(OlDefaultFolde rs.olFolderContacts)

Me.ddlContacts.Clear

If objFolder.Folders.Count > 0 Then

Set myContacts = objFolder.items.Restrict("[Categories] = '" & Category & "'")
If myContacts.Count > 0 Then
myContacts.Sort "[Fullname]", False

For Each ctc In myContacts
Me.ddlContacts.addItem ctc.FullName
Next
End If

For Each fldr In objFolder.Folders
Set myContacts = fldr.items.Restrict("[Categories] = '" & Category & "'")
If myContacts.Count > 0 Then
myContacts.Sort "[Fullname]", False

For Each ctc In myContacts
Me.ddlContacts.addItem ctc.FullName
Next
End If

For Each flder In fldr.Folders
Set myContacts = flder.items.Restrict("[Categories] = '" & Category & "'")
If myContacts.Count > 0 Then
myContacts.Sort "[Fullname]", False

For Each ctc In myContacts
Me.ddlContacts.addItem ctc.FullName
Next
End If

For Each flderr In flder.Folders
Set myContacts = flderr.items.Restrict("[Categories] = '" & Category & "'")
If myContacts.Count > 0 Then
myContacts.Sort "[Fullname]", False

For Each ctc In myContacts
Me.ddlContacts.addItem ctc.FullName
Next
End If
Next
Next
Next



End If

End Sub
Private Sub UserForm_Initialize()

Dim objOutlook As outlook.Application
Dim objNS As outlook.NameSpace
Dim objFolder As outlook.MAPIFolder
Dim Category

Dim arrCategories()
Dim i As Long
Dim lngCount As Long
Dim arrSorted() As Variant
Dim First As Integer
Dim Last As Integer
Set objOutlook = CreateObject("Outlook.Application")

i = 0


lngCount = Application.Session.Categories.Count


ReDim arrCategories(lngCount)
ReDim arrSorted(lngCount)

For Each Category In Application.Session.Categories
arrCategories(i) = Category
i = i + 1
Next

arrSorted = f_SortArray(arrCategories)


First = LBound(arrSorted)
Last = UBound(arrSorted)
For i = First To Last - 1
Me.ddlCategories.addItem arrSorted(i)
Next i

End Sub
Function f_SortArray(ArrayToSort() As Variant) As Variant

Dim First As Integer
Dim Last As Integer
Dim i As Integer
Dim j As Integer
Dim Temp As String

First = LBound(ArrayToSort)
Last = UBound(ArrayToSort)
For i = First To Last - 1
For j = i + 1 To Last
If ArrayToSort(i) > ArrayToSort(j) Then
Temp = ArrayToSort(j)
ArrayToSort(j) = ArrayToSort(i)
ArrayToSort(i) = Temp
End If
Next j
Next i
f_SortArray = ArrayToSort
End Function
Private Sub ddlContacts_Change()

Dim objOutlook As outlook.Application
Dim objNS As outlook.NameSpace
Dim ctcItems As outlook.items
Dim ctc As ContactItem
Dim objFolder As outlook.MAPIFolder
Dim ctcFolder As outlook.MAPIFolder
Dim FolderName As String
Dim ContactName As String
Dim FoundFolder As outlook.folder

Set objOutlook = CreateObject("Outlook.Application")
Set objFolder = objOutlook.Session.GetDefaultFolder(OlDefaultFolde rs.olFolderContacts)

ContactName = Me.ddlContacts.Text


If objFolder.Folders.Count > 0 Then


Set ctcItems = objFolder.items.Restrict("[FullName] = '" & ContactName & "'")
If ctcItems.Count > 0 Then
Me.Hide
For Each ctc In ctcItems


ctc.Display
Next
Exit Sub

Else

For Each fldr In objFolder.Folders
Set ctcItems = fldr.items.Restrict("[FullName] = '" & ContactName & "'")
If ctcItems.Count > 0 Then
Me.Hide
For Each ctc In ctcItems
ctc.Display
Next
Exit Sub
Else
For Each flder In fldr.Folders
Set ctcItems = flder.items.Restrict("[FullName] = '" & ContactName & "'")
If ctcItems.Count > 0 Then
Me.Hide
For Each ctc In ctcItems
ctc.Display
Next
Exit Sub

Else

For Each flderr In flder.Folders
Set ctcItems = flderr.items.Restrict("[FullName] = '" & ContactName & "'")
If ctcItems.Count > 0 Then
Me.Hide
For Each ctc In ctcItems
ctc.Display
Next
Exit Sub

End If
Next
End If
Next

End If

Next

End If



End If

End Sub
Private Function FullFolderName(ByVal FolderName As String) As outlook.folder

End Function