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 strFirstName As String Dim strLastName As String Dim strFileAs As String On Error Resume Next Set objOL = CreateObject("Outlook.Application") Set objNS = objOL.GetNamespace("MAPI") Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts) 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 ' Uncomment the strFileAs line for the desired format 'Lastname, Firstname (Company) format ' strFileAs = .FullNameAndCompany 'Firstname Lastname format ' strFileAs = .FullName 'Lastname, Firstname format ' strFileAs = .LastNameAndFirstName 'Company name only ' strFileAs = .CompanyName 'Companyname (Lastname, Firstname) ' strFileAs = .CompanyAndFullName .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