How to Create a custom “FileAs” contact layout in Outlook 2007

[kraft_mk]

Well, I hope someone might know the answer.



[FONT=&quot]In outlook 2007 , I want to change the “FileAs” default layouts for contacts.[/FONT]Available :
[FONT=&quot]- First Last[/FONT]
[FONT=&quot]- Last, First[/FONT]
[FONT=&quot]- Last, First (Company)[/FONT]
[FONT=&quot]- (Company) Last, First[/FONT]
[FONT=&quot]I want to add one that is not listed or available by default.[/FONT]
[FONT=&quot]The contact should be displayed as:[/FONT]
[FONT=&quot]First Last (Company)[/FONT]
[FONT=&quot]Example :[/FONT]
[FONT=&quot]John Johnson (Green Tech Corp.)[/FONT]

[FONT=&quot]I am submitting a macro for options that are found under Outlook 2007 options.[/FONT]
[FONT=&quot]I want to add a command that will convert (FileAs) all my contacts to:[/FONT]
[FONT=&quot]FirstName LastName (Company)[/FONT]
[FONT=&quot]I tried few combination's but no luck sofar.[/FONT]
[FONT=&quot]Please help.[/FONT]
[FONT=&quot]Thank you[/FONT]
[FONT=&quot]_______________________________[/FONT]

[FONT=&quot]Public Sub ChangeFileAs()[/FONT]
[FONT=&quot] Dim objOL As Outlook.Application[/FONT]
[FONT=&quot] Dim objNS As Outlook.NameSpace[/FONT]
[FONT=&quot] Dim objContact As Outlook.ContactItem[/FONT]
[FONT=&quot] Dim objItems As Outlook.Items[/FONT]
[FONT=&quot] Dim objContactsFolder As Outlook.MAPIFolder[/FONT]
[FONT=&quot] Dim obj As Object[/FONT]
[FONT=&quot] Dim strFirstName As String[/FONT]
[FONT=&quot] Dim strLastName As String[/FONT]
[FONT=&quot] Dim strFileAs As String[/FONT]

[FONT=&quot] On Error Resume Next[/FONT]

[FONT=&quot] Set objOL = CreateObject("Outlook.Application")[/FONT]
[FONT=&quot] Set objNS = objOL.GetNamespace("MAPI")[/FONT]
[FONT=&quot] Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)[/FONT]
[FONT=&quot] Set objItems = objContactsFolder.Items[/FONT]

[FONT=&quot] For Each obj In objItems[/FONT]
[FONT=&quot] 'Test for contact and not distribution list[/FONT]
[FONT=&quot] If obj.Class = olContact Then[/FONT]
[FONT=&quot] Set objContact = obj[/FONT]

[FONT=&quot] With objContact[/FONT]
[FONT=&quot] ' Uncomment the strFileAs line for the desired format[/FONT]

[FONT=&quot] 'Lastname, Firstname (Company) format[/FONT]
[FONT=&quot] ' strFileAs = .FullNameAndCompany[/FONT]

[FONT=&quot] 'Firstname Lastname format[/FONT]
[FONT=&quot] ` strFileAs = .FullName[/FONT]

[FONT=&quot] 'Lastname, Firstname format[/FONT]
[FONT=&quot] ' strFileAs = .LastNameAndFirstName[/FONT]

[FONT=&quot] 'Company name only[/FONT]
[FONT=&quot] ' strFileAs = .CompanyName[/FONT]

[FONT=&quot] 'Companyname (Lastname, Firstname)[/FONT]
[FONT=&quot] ' strFileAs = .CompanyAndFullName[/FONT]

[FONT=&quot] .FileAs = strFileAs[/FONT]

[FONT=&quot] .Save[/FONT]
[FONT=&quot] End With[/FONT]
[FONT=&quot] End If[/FONT]

[FONT=&quot] Err.Clear[/FONT]
[FONT=&quot] Next[/FONT]

[FONT=&quot] Set objOL = Nothing[/FONT]
[FONT=&quot] Set objNS = Nothing[/FONT]
[FONT=&quot] Set obj = Nothing[/FONT]
[FONT=&quot] Set objContact = Nothing[/FONT]
[FONT=&quot] Set objItems = Nothing[/FONT]
[FONT=&quot] Set objContactsFolder = Nothing[/FONT]
[FONT=&quot]End Sub [/FONT]

KraFT