Outlook Userform Combobox Sort Code

[lms]

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

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

So the question is, is there something to add to the code and where, s
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(OlDefaultFolders.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 o
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(OlDefaultFolders.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