To populate a combo box on a Microsoft Outlook form

Code Sample

Function Item_Open() Dim oRecordSet Dim oPage, oCtrl On Error Resume Next  Set oRecordSet = GetFolderRS("IPM.Contact", "", "FileAs , EntryID", True) Set oPage = Item.GetInspector.ModifiedFormPages("P.2") Set oCtrl = oPage.Controls("cboAgencyContacts") If UCase(TypeName(oRecordSet)) <> "RECORDSET" Then Exit Function While Not oRecordSet.EOF  oCtrl.AddItem(oRecordSet.Fields("FileAs").Value)  oRecordSet.MoveNext Wend End Function  Function GetFolderRS(FormFilter, FindFilter, ShowColumns, fSort) 'FormFilter is a string variable that contains a comma-delimited list 'of outlook FormClasses (i.e., "IPM.Contact , IPM.Contact.Account") 'that you would like to limit the result set to. 'FindFilter is the search criteria you may want to impose 'i.e., FindFilter = "Wakeman" will search the FileAs or Subject field 'and return item 'Richard Wakeman' 'ShowColumns is a string variable that contains a comma-delimited list 'of the fields you actually NEED. 'fSort is a Boolean flag indicating whether you want to sort by the 'subject property Dim oNamespace, oSession Dim oOlFolder, oCdoFolder Dim oMessages, oMessage, oFilter Dim oRS, oFld, fAddRecord, fVerifyType, strBuffer On Error Resume Next fVerifyType = False Err.Clear 'Get the Folder that contains the contacts (Outlook is easier than CDO) Set oNamespace = Application.GetNamespace("MAPI") Set oOlFolder = oNamespace.Folders("Public Folders"). _ Folders("All Public Folders"). _ Folders("Agency Manager"). _ Folders("Agency Contacts") If Err <> 0 Then Exit Function 'Create a CDO Session and Logon with active Outlook profile Set oSession = CreateObject("MAPI.Session") oSession.Logon "", "", False, False, 0 If Err <> 0 Then Exit Function 'Get the CDO object for the Folder using the Outlook Folder IDs Set oCdoFolder = oSession.GetFolder(oOlFolder.EntryID, _ oOlFolder.StoreID) 'verify that the infostore exists Set oMessages = oCdoFolder.Messages If Err <> 0 Then Exit Function 'create an ADO Recordset object 'ADO is installed with Office 2K so this should work fine. Set oRS = CreateObject("ADODB.RecordSet") If Err <> 0 Then Exit Function 'Add whatever fields to the recordset that you may WANT! 'ShowColumns is a string variable that contains a comma-delimited list 'of the fields you actually NEED. With oRS If ShowColumns = "" Then ' &HC8 = adVarChar (Text Field) .Fields.Append "FileAs", "&HC8", 255  .Fields.Append "FullName", "&HC8", 255 .Fields.Append "CompanyName", "&HC8", 255 .Fields.Append "JobTitle", "&HC8", 255 .Fields.Append "MailingAddressCity", "&HC8", 255 .Fields.Append "MailingAddressState", "&HC8", 255 .Fields.Append "EntryID", "&HC8", 255 Else If InStr(ShowColumns, "FileAs") > 0 Then .Fields.Append "FileAs", "&HC8", 255 End If If InStr(ShowColumns, "FullName") > 0 Then .Fields.Append "FullName", "&HC8", 255 End If If InStr(ShowColumns, "CompanyName") > 0 Then .Fields.Append "CompanyName", "&HC8", 255 End If If InStr(ShowColumns, "JobTitle") > 0 Then .Fields.Append "JobTitle", "&HC8", 255 End If If InStr(ShowColumns, "City") > 0 Then .Fields.Append "MailingAddressCity", "&HC8", 255 End If If InStr(ShowColumns, "State") > 0 Then .Fields.Append "MailingAddressState", "&HC8", 255 End If If InStr(ShowColumns, "EntryID") > 0 Then .Fields.Append "EntryID", "&HC8", 255 End If End If .Open If FormFilter <> "" Or FindFilter <> "" Then 'FormFilter is a string variable that contains a comma-delimited list 'of outlook FormClasses (i.e., "IPM.Contact , IPM.Contact.Account") 'that you would like to limit the result set to. 'FindFilter is the search criteria you may want to impose 'i.e., FindFilter = "Wakeman" will search the designated field 'and return item 'Richard Wakeman' Set oFilter = oMessages.Filter If FormFilter <> "" Then If InStr(FormFilter, ",") > 0 Then 'if there is more than 1 qualify in the for each below fVerifyType = True Else oFilter.Type = FormFilter End If End If 'The FileAs field is undocumented for CDO and means to access such fields 'can be found at http://www.cdolive.com/cdo10.htm 'CdoPR_ constants are part of the MAPI Library If FindFilter <> "" Then 'Filter FileAs field (uses like operator by design) oFilter.Fields.Add "0x8005", vbString, FindFilter, _ "0420060000000000C000000000000046" 'if you would prefer to use the subject field use this construct 'oFilter.Subject = FindFilter End If End If 'Sort by Subject ' alternatively, don't sort here, but sort the Recordset itself ' after you fill it. If fSort Then oMessages.Sort 1, "&H37001E" 'CdoPR_SUBJECT End If If Err <> 0 Then Exit Function 'Loop through the result set and add to the ADO Recordset For Each oMessage In oMessages fAddRecord = False strBuffer = "" 'Get FileAs Field value to test if valid contact strBuffer = oMessage.Fields("0x8005", _ "0420060000000000C000000000000046") If strBuffer <> "" Then fAddRecord = True 'If more than on FormClass was specified,  ' check if the Item's FormClass is correct If fAddRecord And fVerifyType Then If InStr(FormFilter, oMessage.Type) = 0 Then fAddRecord = False End If End If 'Add a new ADO Record and loop through the Recordset fields  'to fetch data from the item If fAddRecord Then .AddNew For Each oFld In .Fields Select Case oFld.Name Case "FileAs" oFld.Value = strBuffer Case "FullName" 'CdoPR_DISPLAY_NAME oFld.Value = oMessage.Fields(805371934)  Case "CompanyName" 'CdoPR_COMPANY_NAME oFld.Value = oMessage.Fields(974520350)  Case "JobTitle" 'CdoPR_TITLE oFld.Value = oMessage.Fields(974585886)  Case "MailingAddressCity" 'CdoPR_LOCALITY oFld.Value = oMessage.Fields(975634462)  Case "MailingAddressState" 'CdoPR_STATE_OR_PROVINCE oFld.Value = oMessage.Fields(975699998) Case "EntryID" oFld.Value = oMessage.ID End Select Next End If Next oMessages.Filter = Nothing .MoveFirst End With Set GetFolderRS = oRS Proc_Bye: Set oNamespace = Nothing Set oSession = Nothing Set oOlFolder = Nothing Set oCdoFolder = Nothing Set oMessages = Nothing Set oMessage = Nothing Set oFilter = Nothing End Function  

Notes

If you want to use the recordset for lookups, you can use this syntax:

Set oRecordSet = GetFolderRS _ ("IPM.Contact.Team Member , IPM.Contact.Account", _   "Smith, Wakeman", "FullName, CompanyName , EntryID", False)   

This would look up all Smiths and Wakemans using the custom Outlook Forms 'Team Member' or 'Account'.

If you want to show data from fields other than those listed in the code, you'll need to use the correct MAPI property tag. See Digging deeper into CDO, Property Tags and Types.

More Information

• Connecting Outlook and Exchange to Databases
• School Calendar Form -- how to populate drop-down lists on an Outlook form from Microsoft Access data
• Populate a combo box of an Outlook form with the Global Address List -- using CDO
• Company-Contact Selector sample form