How to Clean Up Outlook Contact Phone Numbers using VBA
I got a new phone and when synchronised with Microsoft Outlook, the phone numbers don’t dial out properly because of spaces & STD bracketing. It’s an LG – the previous Nokia was great, as was it’s synchronising software!
I used VBA in a workaround via Microsoft Excel! (If you don’t have Excel, this won’t work…). It will convert phone numbers like (+44) 1234 456789 to 0044123456789. It also removes “-” entries and ones with multiple spaces as a number, like ” ” which are invisible but muck stuff up! [but see later addendum for later code additions, code is here: FixPhoneNumbers – SP]
Export the “Contacts” folder from Outlook as an Excel spreadsheet to your hard drive. Give it a sensible name!
Open the Excel file and then press Alt + F11 to open the Visual Basic Editor (VBE). We’re gonna write code now!
Insert a new code module. You can give it a name if you like. I didn’t and just left it as it was.
Copy this VBA code into the module in the VBE. (That’s a screenshot of my code above!)
Option Explicit Public Sub FixPhoneNumbers() Dim rg As Range Dim r As Integer Dim c As Integer Dim wks As Worksheet Dim s As String Application.ScreenUpdating = False Set wks = ThisWorkbook.ActiveSheet r = wks.Cells(1, 1).CurrentRegion.Rows.Count c = wks.Cells(1, 1).CurrentRegion.Columns.Count With wks .Columns("AD:AT").NumberFormat = "@" For c = 30 To 46 Step 1 'all phone fields For r = 2 To .Cells(1, 1).CurrentRegion.Rows.Count Set rg = .Cells(r, c) s = rg.Value s = Replace(s, "(", "") s = Replace(s, " ", "") s = Replace(s, ")", "") s = Replace(s, "+44", "0044") s = Replace(s, "+", "00") s = Replace(s, "-", "") If Len(s) < 7 And Len(s) > 0 Then s = "01278" & s 'assume local phone # rg.Value = s Next r Next c End With Application.ScreenUpdating = True Set rg = Nothing Set wks = Nothing End Sub
The key is the lines with the Replace function. Additional lines can be easily added if more gotchas are spotted in your own numbers.
If you don’t need a line to run, remark (Rem) it out by putting an apostrophe at the line beginning, like this one here… ‘
From the Debug menu in the VBE, compile the code. This ensures that no typos etc have got in.
Save the file.
Now run the procedure called “FixPhoneNumbers”. The simplest way to do this is to make sure the screen cursor is somewhere within the code you’ve copied in – and then hit F5 on the keyboard.
If this is confusing, go to the main Excel screen, hit Alt + F8 and run the macro, which unsurprisingly is called “FixPhoneNumbers”!!
Save the file again if the changes look alright.
If they’re not, then close the file without saving, then re-open, and adjust the VBA code to suit your columns, which will be the most likely thing you’ll need to adjust.
Then do all the above again, from the Fifth Step onwards.
Import the file back into Outlook.
Overwrite old contacts with the new ones.
There should be no need to map fields etc because we haven’t mucked about with them!
- The code is designed to work with a standard output dump from Outlook. If you’ve added or removed fields from the contacts part of Outlook, the export will be different and you’ll need to check which columns contain phone numbers. Modify the VBA code to suit. In total, there were 92 columns in the export from Outlook, so if you don’t have this number then you’ll probably need a quick code modification. (That’s why I checked the count at the beginning of the code with the CurrentRegion bit so that I could get the dataset size. In the end, I only needed a row count, but I’ve left the code in so that you can step through the code using F8 to check yours out. Clear? Don’t worry. )
- Some entries I had were local phone numbers. My code is 01278 so this is added and will need changing to suit your own local STD code if you’ve entered phone numbers without the exchange.
- I check that the UK international code is correct. Change the 44 to your own as appropriate.
- There’s no error checking in the code. But it should work – it did for me!
This code is smoother and has more features than previously, although I still don’t error check.
It’s advantages are:
- It checks all columns and looks for the words “Phone” or “Fax” in the data headings. In this way, any logical Outlook customisations are taken care of!
- It prompts the user for their local STD and National codes, placing these in the correct place.
- I’ll turn the code into an xla add-in with a one-click button.
- I’ll make the whole thing work directly on the Outlook contacts from within Outlook. I’ve used the Outlook object model before, just not very often! So watch this space as current Outlook addins are pricey and a bit of a kludge from what I’ve read…
The New (Improved) Code Version
Download plain text version: FixPhoneNumbers
Option Explicit Public Sub FixPhoneNumbers() Dim rg As Range Dim r As Integer Dim c As Integer Dim wks As Worksheet Dim s As String Dim LocalCode As Variant Dim NationalCode As Variant Application.ScreenUpdating = False LocalCode = InputBox("Do You want Full Code for Local Numbers?" _ , "Enter local STD/City dialling code" _ , "01278") NationalCode = InputBox("Do You want cleaned up National Code? e.g. 44=UK" _ & vbCrLf _ & "+44 goes to 0044" _ , "Enter National code" _ , "44") Set wks = ThisWorkbook.ActiveSheet With wks .Range(.Cells(1, 1), .Cells(1, 1).End(xlToRight)).Font.Bold = True For c = 1 To .Cells(1, 1).CurrentRegion.Columns.Count Step 1 'all columns s = LCase(.Cells(1, c).Value) 's picks up column heading 'lower case to match search string later 'as text compare doesn't work 'now find phone/fax fields and if found, fix numbers If (InStr(s, "phone") + InStr(s, "fax")) > 0 Then .Columns(c).NumberFormat = "@" 'make text format for tel nos 'allows leading zeroes! For r = 2 To .Cells(1, 1).CurrentRegion.Rows.Count Set rg = .Cells(r, c) s = rg.Value 're-use s s = Replace(s, "(", "") s = Replace(s, " ", "") s = Replace(s, ")", "") If Len(NationalCode) > 0 Then 'not empty string s = Replace(s, "+" & NationalCode, "00" & NationalCode) End If s = Replace(s, "+", "00") s = Replace(s, "-", "") If Len(s) < 7 And Len(s) > 0 Then s = LocalCode & s rg.Value = s Next r Else 'nowt End If Next c End With Application.ScreenUpdating = True Set rg = Nothing Set wks = Nothing End Sub
CHANGE Contact data Different Download Drive EMPTY Excel GREAT International Keyboard logic MAIN Microsoft name NOTHING NUMBERS Outlook PRESS public RE screenshot SOFTWARE SP spreadsheet STD Step UK VBA war