Monthly Archives:August 2010

Introduction

VBA for Fix Phone Numbers

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:

1. 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!
2. It prompts the user for their local STD and National codes, placing these in the correct place.

Next Steps:

1. I’ll turn the code into an xla add-in with a one-click button.
2. 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