Jabtech
asked on
Outlook Address Book
Is it possible to sort your contacts by "Company" when selecting them from the Address book in Outlook? The company field (column) is listed when searching the GAL, but it's not listed as an option when searching the contacts address book.
Coincidentally this was available when a BlackBerry was connected to the mailbox, but after we switched to an Active Sync device it went missing.
Coincidentally this was available when a BlackBerry was connected to the mailbox, but after we switched to an Active Sync device it went missing.
ASKER
It happens in Outlook 2010 and 2013. The issue isn't in the contacts section of Outlook, it's when creating a new e-mail message, selecting TO field and then seleceting your contacts address book from the drop down box.
I've attached a few examples.
The first one shows the Company column in the GAL.
The second shows the contacts address list that is missing the Company column.
Image1.png
Image2.png
I've attached a few examples.
The first one shows the Company column in the GAL.
The second shows the contacts address list that is missing the Company column.
Image1.png
Image2.png
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
@NRhode - good tip. Thank you. Here is another solution that resolved the issue. Basically custom Macro or coding. I believe this is what the Contact Genie is doing:
Public Sub ChangeFileAs()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objContact As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim objContactsFolder As Outlook.MAPIFolder
Dim obj As Object
Dim strFileAs As String
Dim myRegKey As String
Dim myValue As String
Dim myFileAs As String
Dim myAnswer As Integer
On Error Resume Next
' get registry key to work with
' change the Outlook version # to match your version
myRegKey = "HKEY_CURRENT_USER\Softwar e\Microsof t\Office\1 5.0\Outloo k\Contact\ FileAsOrde r"
If myRegKey = "" Then Exit Sub
'check if key exists
If RegKeyExists(myRegKey) = True Then
'key exists, read it
myValue = RegKeyRead(myRegKey)
If myValue = 14870 Then myFileAs = "Company"
If myValue = 32791 Then myFileAs = "Last, First"
If myValue = 32792 Then myFileAs = "Company (Last, First)"
If myValue = 32793 Then myFileAs = "Last, First (Company)"
If myValue = 32823 Then myFileAs = "First Last"
'display result and ask if it should be changed
myAnswer = MsgBox("The registry value for the key """ & _
myRegKey & """is """ & myFileAs & vbCrLf & _
"Do you want to change it?", vbYesNo)
Else
'key doesn't exist, ask if it should be created
myAnswer = MsgBox("The registry key """ & myRegKey & _
""" could not be found." & vbCr & vbCr & _
"Do you want to create it?", vbYesNo)
End If
If myAnswer = vbYes Then
'ask for new registry key value
myValue = InputBox("Please enter new value: " & vbCrLf & _
"14870 = Company" & vbCrLf & _
"32791 = Last, First" & vbCrLf & _
"32792 = Company (Last, First)" & vbCrLf & _
"32793 = Last, First (Company)" & vbCrLf & _
"32823 = First Last", myRegKey, myValue)
If myValue <> "" Then
RegKeySave myRegKey, myValue
MsgBox "Registry key saved."
End If
Else
End If
' now that we've got the value of the default setting,
' we use it to set the value so all contacts are the same
Set objOL = CreateObject("Outlook.Appl ication")
Set objNS = objOL.GetNamespace("MAPI")
Set objContactsFolder = objNS.GetDefaultFolder(olF olderConta cts)
Set objItems = objContactsFolder.Items
For Each obj In objItems
'Test for contact and not distribution list
If obj.Class = olContact Then
Set objContact = obj
With objContact
If myValue = 14870 Then strFileAs = .CompanyName '"Company"
If myValue = 32791 Then strFileAs = .LastNameAndFirstName '"Last, First"
If myValue = 32792 Then strFileAs = .CompanyAndFullName '"Company (Last, First)"
If myValue = 32793 Then strFileAs = .FullNameAndCompany '"Last, First (Company)"
If myValue = 32823 Then strFileAs = .FullName '"First Last"
.FileAs = strFileAs
.Save
End With
End If
Err.Clear
Next
Set objOL = Nothing
Set objNS = Nothing
Set obj = Nothing
Set objContact = Nothing
Set objItems = Nothing
Set objContactsFolder = Nothing
End Sub
'reads the value for the registry key i_RegKey
'if the key cannot be found, the return value is ""
Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object
On Error Resume Next
'access Windows scripting
Set myWS = CreateObject("WScript.Shel l")
'read key from registry
RegKeyRead = myWS.RegRead(i_RegKey)
End Function
'sets the registry key i_RegKey to the
'value i_Value with type i_Type
'if i_Type is omitted, the value will be saved as string
'if i_RegKey wasn't found, a new registry key will be created
Sub RegKeySave(i_RegKey As String, _
i_Value As String, _
Optional i_Type As String = "REG_DWORD")
Dim myWS As Object
'access Windows scripting
Set myWS = CreateObject("WScript.Shel l")
'write registry key
myWS.RegWrite i_RegKey, i_Value, i_Type
End Sub
'returns True if the registry key i_RegKey was found
'and False if not
Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object
On Error GoTo ErrorHandler
'access Windows scripting
Set myWS = CreateObject("WScript.Shel l")
'try to read the registry key
myWS.RegRead i_RegKey
'key was found
RegKeyExists = True
Exit Function
ErrorHandler:
'key was not found
RegKeyExists = False
End Function
Public Sub ChangeFileAs()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objContact As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim objContactsFolder As Outlook.MAPIFolder
Dim obj As Object
Dim strFileAs As String
Dim myRegKey As String
Dim myValue As String
Dim myFileAs As String
Dim myAnswer As Integer
On Error Resume Next
' get registry key to work with
' change the Outlook version # to match your version
myRegKey = "HKEY_CURRENT_USER\Softwar
If myRegKey = "" Then Exit Sub
'check if key exists
If RegKeyExists(myRegKey) = True Then
'key exists, read it
myValue = RegKeyRead(myRegKey)
If myValue = 14870 Then myFileAs = "Company"
If myValue = 32791 Then myFileAs = "Last, First"
If myValue = 32792 Then myFileAs = "Company (Last, First)"
If myValue = 32793 Then myFileAs = "Last, First (Company)"
If myValue = 32823 Then myFileAs = "First Last"
'display result and ask if it should be changed
myAnswer = MsgBox("The registry value for the key """ & _
myRegKey & """is """ & myFileAs & vbCrLf & _
"Do you want to change it?", vbYesNo)
Else
'key doesn't exist, ask if it should be created
myAnswer = MsgBox("The registry key """ & myRegKey & _
""" could not be found." & vbCr & vbCr & _
"Do you want to create it?", vbYesNo)
End If
If myAnswer = vbYes Then
'ask for new registry key value
myValue = InputBox("Please enter new value: " & vbCrLf & _
"14870 = Company" & vbCrLf & _
"32791 = Last, First" & vbCrLf & _
"32792 = Company (Last, First)" & vbCrLf & _
"32793 = Last, First (Company)" & vbCrLf & _
"32823 = First Last", myRegKey, myValue)
If myValue <> "" Then
RegKeySave myRegKey, myValue
MsgBox "Registry key saved."
End If
Else
End If
' now that we've got the value of the default setting,
' we use it to set the value so all contacts are the same
Set objOL = CreateObject("Outlook.Appl
Set objNS = objOL.GetNamespace("MAPI")
Set objContactsFolder = objNS.GetDefaultFolder(olF
Set objItems = objContactsFolder.Items
For Each obj In objItems
'Test for contact and not distribution list
If obj.Class = olContact Then
Set objContact = obj
With objContact
If myValue = 14870 Then strFileAs = .CompanyName '"Company"
If myValue = 32791 Then strFileAs = .LastNameAndFirstName '"Last, First"
If myValue = 32792 Then strFileAs = .CompanyAndFullName '"Company (Last, First)"
If myValue = 32793 Then strFileAs = .FullNameAndCompany '"Last, First (Company)"
If myValue = 32823 Then strFileAs = .FullName '"First Last"
.FileAs = strFileAs
.Save
End With
End If
Err.Clear
Next
Set objOL = Nothing
Set objNS = Nothing
Set obj = Nothing
Set objContact = Nothing
Set objItems = Nothing
Set objContactsFolder = Nothing
End Sub
'reads the value for the registry key i_RegKey
'if the key cannot be found, the return value is ""
Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object
On Error Resume Next
'access Windows scripting
Set myWS = CreateObject("WScript.Shel
'read key from registry
RegKeyRead = myWS.RegRead(i_RegKey)
End Function
'sets the registry key i_RegKey to the
'value i_Value with type i_Type
'if i_Type is omitted, the value will be saved as string
'if i_RegKey wasn't found, a new registry key will be created
Sub RegKeySave(i_RegKey As String, _
i_Value As String, _
Optional i_Type As String = "REG_DWORD")
Dim myWS As Object
'access Windows scripting
Set myWS = CreateObject("WScript.Shel
'write registry key
myWS.RegWrite i_RegKey, i_Value, i_Type
End Sub
'returns True if the registry key i_RegKey was found
'and False if not
Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object
On Error GoTo ErrorHandler
'access Windows scripting
Set myWS = CreateObject("WScript.Shel
'try to read the registry key
myWS.RegRead i_RegKey
'key was found
RegKeyExists = True
Exit Function
ErrorHandler:
'key was not found
RegKeyExists = False
End Function
Company should be a default field in that list and if it is not available you can add it by right-clicking the field bar > choose "field chooser" > add the fields you want to sort by or see