Mass Updating SaveAs Field in Outlook Contacts

If you ever had a problem that you needed to change SaveAs field in contacts in Microsoft Outlook on all contacts here is one small VB script that parse everything for you.

The only thing that you need to do is uncomment proper part of the code which is strFileAs.

In my case I wanted to everything be formated as Firstname Lastname instead of reverse way that is default in outlook.

Press alt+f11 to open vb editor, paste the code, edit strFileAs and press F5 to run it. When it’s done you will have your contacs sorted and changed in your way.

P.S. removing comment in vb means removing sign ’ in front of the line or text, so if you want to comment something write ’ in front of the line. In this case you will comment out strFileAs = .FullName part if you don’t want to be Firstname Lastname format and uncomment some other strFileAs line that fits your needs.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
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