#1
|
|||
|
|||
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(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 |
#2
|
|||
|
|||
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 |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Outlook 2007 Code For Matching Textbox to a Combobox in a Different Form | lms | Outlook | 4 | 07-03-2013 08:34 AM |
VB code: populate combobox from columns in Excel file | billybeach | Outlook | 2 | 04-27-2013 04:38 AM |
Code to export value from ComboBox | ilkks | Word VBA | 7 | 05-25-2011 04:06 AM |
Outlook 2007 Contacts Sort Order | bianson | Outlook | 2 | 01-27-2011 10:32 AM |
MS Outlook 2002 Address Book Sort Problem.... | blizzster | Outlook | 0 | 07-30-2009 07:52 AM |