Outlook ComboBox Sort Code

Outlook ComboBox Sort Code

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  I click on one of the Categories, the Combobox named "ddlContacts" shows the list of all contacts assigned to the Category I clicked 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(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 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(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