The following code searches all Categories for the contacts that are in each Category, and this includes contacts from the Contact folder, and it's sub-folders, sub-sub folders, and its sub-sub-sub folders. So the Combobox named "ddlCategories" shows the list of all Categories and when click on one of the Categories, the Combobox named "ddlContacts" shows the list of all contacts assigned to the Category I click on, and as to the list of Contacts that show up, each one is link to the specific contact so when I click on the Contact name, it opens up the Contact itself.

But what has happened is that the list of the Categories are not sorted on an alphabetical basis....and the Contacts that show up which are from different folders, are sorted alphabetically as to each folder it comes from, not sorted simply as to all the contacts.

So the question is, is there something to add to the code and where, so that each Combobox sorts what shows up on a full alphabetical basis? Thanks to all.



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()
'The loads the Outlook userform and populates the combobox of contact folders.

Dim objOutlook As outlook.Application
Dim objNS As outlook.NameSpace
Dim objFolder As outlook.MAPIFolder
Dim Category
Set objOutlook = CreateObject("Outlook.Application")

For Each Category In Application.Session.Categories
Me.ddlCategories.addItem Category
Next




End Sub



Private Sub ddlContacts_Change()
'This opens the contact form for the contact selected.
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