Introduction
[caption id="attachment_7856" align="alignright" width="300" caption="VBA for Fix Phone Numbers"]
[/caption]
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!
Solution
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]
First Step
Export the "Contacts" folder from Outlook as an Excel spreadsheet to your hard drive. Give it a sensible name!
Second Step
Open the Excel file and then press Alt + F11 to open the Visual Basic Editor (VBE). We're gonna write code now!
Third Step
Insert a new code module. You can give it a name if you like. I didn't and just left it as it was.
Fourth Step
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... '
Fifth Step
From the Debug menu in the VBE, compile the code. This ensures that no typos etc have got in.
Save the file.
Sixth Step
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"!!
Seventh Step
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.
Eighth Step
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!
Caveats
- 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!
ADDENDUM: New Code Version!
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.
Next Steps:
- 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
This article is a copy of one formally at this web address. This is currently down and is repeated here in its entirety as a public service! It's suspected of being hacked, as described here on LazyManAndMoney. This page will be removed if all is okay. (scheduled to release at midnight Friday 27/08/2010)
