This version of the Bulk Change File As Format for Contacts macro checks the registry for the user's default FileAs format and offers to change it. It then updates the contacts in the default contact folder to use the default FileAs format.
It's not the cleanest code, but it works in all versions of Outlook and gets the job done.
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\Software\Microsoft\Office\15.0\Outlook\Contact\FileAsOrder"
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.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
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.Shell")
'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.Shell")
'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.Shell")
'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
How to use the macros on this page
First: You need to have macro security set to the lowest setting, Enable all macros during testing. The macros will not work with the top two options that disable all macros or unsigned macros. You could choose the option Notification for all macros, then accept it each time you restart Outlook, however, because it's somewhat hard to sneak macros into Outlook (unlike in Word and Excel), allowing all macros is safe, especially during the testing phase. You can sign the macro when it is finished and change the macro security to notify.
To check your macro security in Outlook 2010 and newer, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, look at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
The macros on this page should be placed in a module.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
Timothy says
Thank you Diane! This saved a lot of time. Appreciate you sharing it. Blessings.
Martin Midgley says
Thank you Diane; that's so helpful. I had to tweak the registry address from ""HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Outlook\Contact\FileAsOrder"" to "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Contact\FileAsOrder"" for Outlook 2007, but that's no big deal. What gets me though is that it was necessary in the first place. Perhaps there's someone at Redmond who goes by the unfortunate name of "Smith Comma Fred", but otherwise I think you'd have to go back to 19th century London to find people in the workplace referring to each other by their surnames. So why order the contacts by surname by default? Really odd.
Marty Sullivan says
Me again......Trying to apply macro to new Office 365. Keep getting the error "User-defined type not defined". Beow is what is highlighted.
Public Sub ChangeFileAs()
Dim objOL As Outlook.Application
Marty says
Update.....all set....
Marty
Marty says
Hello,
I have used this code on my personal laptop and it worked fine. I am now trying to use it on my work laptop and I keep getting the prompt to choose a macro, but none are listed.
Any ideas?
Marty
Diane Poremsky says
Do you have macro security set to allow it and the macro project properly signed if using allow signed macro only?
Marty Sullivan says
So sorry to ask, but I forgot how to actually apply the code?
Diane Poremsky says
Alt+F11 to open the editor, paste the code into a module or thisoutlooksession then click Run.
This macro runs on all of the contacts in the default contacts folder.
Robert L says
I forgot to block it as code..... (remove my previous comment)
strFileAs = .FileAs 'Keep as is if no conditions are metIf 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 And .CompanyName <> "" And .FullName = "" Then strFileAs = .CompanyName '"Company"
If myValue = 32823 And .FullName <> "" Then strFileAs = .FullName '"First Last"
Robert L says
Your code is absolute GOLD! I had to remember how to get to the macros and create a new module tho ...haha. But it ran to perfection!.
One minor suggestion. I have about 10 contacts that are Company name only. When I chose First Name Last Name, The 10 contacts did not stay as FileAs CompanyName. They got cleared out. I'll probably modify the code but thought you might want to change it.
Travis Abdo says
Amazing! So glad I came across your code.
Saved me a few hours.
Major CUDOS!!!!
Eric says
Great job Diane! This code was a huge help. Thanks!
Bob Alvarez says
Worked Great for my default Outlook 365 account but I cannot get it to run for my other Outlook 2013 accounts, even after changing one to the default account. Any ideas?
Diane Poremsky says
This calls the default calendar:
Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
this would work with the selected folder:
Set objContactsFolder = Application.ActiveExplorer.CurrentFolder
I have no idea why it failed - try commenting out every on error resume next line and see where it stops.
David De La Rosa says
Thank you for the help! it works great!!!!!!!
Thomas says
Dear Diane, this is now the second time I was able to resolve a huge problem with one of your codes. Many thanks! You're the best!
Diane Poremsky says
You're welcome!
Dennis says
This works like a CHARM!!!!
Jim Wimberly says
This worked perfect for me, for Outlook 2010. I used this in conjunction with the code for Bulk Change Email Display Name Format (I ran that code first, then this code). A great resource. thanks.
Alan says
It worked! Thank you. First swing at VB...
Julian says
Just used this macro. Did just what I wanted. Thanks very much.
Martin says
I might be being greedy asking a 2nd question, but here goes....
when importing contacts Outlook appears to have removed the '+' from infront of the international numbers that I have against contacts. Is there any way of reinserting it?
Diane Poremsky says
I'd use the method here - https://www.slipstick.com/developer/remove-prefix-phone-number/ - to check the contacts and add it back. See the AddPrefix function at the bottom.
Martin says
Forgive the dumb question, but I've never used VBL before...
Is the code that im using simply everything from 'public Sub' through to 'End Program'? Or do I have to enter it chunks ¬ copy instructions in green?
Diane Poremsky says
You need all of the code. Double click in it to select it - if it selects then deselects, press Ctrl+A then copy and paste into the VBA Editor. You can right click on Project1 in the editor and choose Insert > Module and paste it into the module.
Martin says
It worked! Thank you so much!!! #happyman
Marcio Ehrlich says
I want to give you a big kiss! I could not believe my eyes when I opened my Outlook again and each and every name was filed as I wanted!!
Really, what an invaluable help. I am so thankful that you can count on me if there is anything you need in Rio de Janeiro, Brazil.
Diane Poremsky says
Thanks! I'll let you know if I'm ever in Rio. :)
Alane McKinnon says
Awesome tool! Worked beautifully on approx. 1700 contacts which had been screwed up by syncing with Outlook.com. Which, BTW, does not seem to recognize any "File As" except "First Name, Last Name" or "Last Name, First Name". "Company (Last Name, First Name) is not even an option, which happens to be my preferred "File As" option. Many thanks!
Diane Poremsky says
Yeah, Outlook.com doesn't support all file as types so it can make a mess of things.
Doug says
Is there a way to run this on a contact folder other than the default?
Thank you!
Diane Poremsky says
You need to replace this part:
Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
Set objItems = objContactsFolder.Items
For Each obj In objItems
with the same section of code at bulk changed selected contacts - you need some of the dim and set statements too.
Rob says
thanks for your reply. I was able to run the script. My goal is to bulk change FileAs.
This is my 1st time doing this. Here are the steps I am taking to implement:
1. Within Outlook 2010, changed:
-Default Full Name setting to "First (Middle) Last"
-Default File As order to "First Last"
-Lowered macro security
2.Opened VBAProject.OTM within Outlook.
3. Copy and Pasted script
4. Ran script and went through steps and saved reg key
5. Saved and closed
6. closed outlook 2010
7. re-opened to find the changes did not apply
What did i do wrong? please help
thank you
Diane Poremsky says
How many contacts folders do you have? This code works only on the default contacts folder.
Did you change the 15 to 14:
myRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\15.0\Outlook\Contact\FileAsOrder"
rob says
i have a silly question...how do I run this script? I need to change FileAs so that "first name,lastname" appears. I have changed the default to that setting. Now i just need to run the script to change all 6338 contacts.
Please let me know.
Thank you.
Diane Poremsky says
Assuming your macro security is set to low or off - then press F5 or the Run button on the VBA Editor's toolbar. Screenshots are in How to use the VBA editor
Diane Poremsky says
Try replacing the FileAS code block in the macro link i posted earlier with the following code then run the macro.
If obj.Class = olContact Then
Set objContact = obj
With objContact
.Body = ""
.Save
End With
End If
Nox says
Hi
I need urgent help, please.
Outlook 2010, "Contact Notes" keeps a "change log", greyed perforated line with date, when info has been changed.
This seems to of grown rather large and prevents my "Samsung Galaxy S2" android phones from synching with exchange.
What I'de like to ask, is there a script / macro to delete ALL notes for multiple contacts ?
As a interim solution I exported all my contacts to Excel without notes and imported them again, the phone now synchs without any issues, but obviously all my contact pictures are gone as well.
I'de greatly appreciate any assistance.
Regards
Nox
Diane Poremsky says
I don't have a script handy but it should be fairly simple to put one together by tweaking the super-duper Bulk change contacts macro.
Diane Poremsky says
Also, if you don't need the updates, you can disable them. See Help! My Contacts are being updated!