Updating Outlook Contact Phone Nos to international dialling codes

[AndrewDJohnson]

Skype has an annoying feature when using outlook contacts - it cannot automatically add country codes, even though it CAN do this when you do "call phones" - crazy... anyway, this bug has been present in Skype for years, so I wanted a work around. Using code found on a forum,

http://windowssecrets.com/forums/sh...nd-contacts-using-Outlook-VBA-without-looping
I made this code. Change the my_country_code to your country code and away you go... Back up your contacts first!

=============

Sub correct_phone_nos_country_code() 
 
Dim olApp As Outlook.Application 
 
Dim myNameSpace As Outlook.NameSpace 
 
Dim objFolder As Outlook.MAPIFolder 
 
Dim objItems As Outlook.Items 
 
Dim objItem As Object, objAdd As Object 
 
Dim new_no As String 
 
'Loop through all the contacts 
 
Set olApp = CreateObject("Outlook.Application") 
 
Set myNameSpace = olApp.GetNamespace("MAPI") 
 
Set objFolder = myNameSpace.GetDefaultFolder(olFolderContacts) ' <-- Main (default) contacts folder 
 
' objFolder.ShowAsOutlookAB = True ' ticks box to see folder content items as contacts 
 
Set objItems = objFolder.Items 
 
For Each objItem In objItems 
 
' Make sure we have a contact item 
 
With objItem 
 
If .Class = olContact Then 
 
Debug.Print .FileAs, .BusinessTelephoneNumber, .HomeTelephoneNumber, .MobileTelephoneNumber 
 
> HomeTelephoneNumber = correct_phone_no_to_international(.HomeTelephoneNumber) 
 
> BusinessTelephoneNumber = correct_phone_no_to_international(.BusinessTelephoneNumber) 
 
> HomeTelephoneNumber = correct_phone_no_to_international(.HomeTelephoneNumber) 
 
> MobileTelephoneNumber = correct_phone_no_to_international(.MobileTelephoneNumber) 
 
> BusinessFaxNumber = correct_phone_no_to_international(.BusinessFaxNumber) 
 
objItem.Save 
 
End If 
 
End With 
 
Next 
 
End Sub 
 
'============================================= 
 
Function correct_phone_no_to_international(phone_no As String) As String 
 
Dim new_phone_no As String 
 
Dim my_country_code As String 
 
'****change this to your country code: 
 
my_country_code = "+44" 
 
'*********** 
 
If Len(Trim(phone_no)) = 0 Then
   change_phone_no_to_international = ""
   Exit Function 
 
End If 
 
If Left$(phone_no, 1) <> "+" Then
   new_phone_no = my_country_code + Mid$(phone_no, 2)
   correct_phone_no_to_international = new_phone_no 
 
End If 
 
End Function

 

[larry]

Thanks for posting this!

 

[Diane Poremsky]

Thanks for sharing this with us.

 

[AndrewDJohnson]

There is a bug in the original code I tried to edit my post, but couldn't - corrected code below.

Sub correct_phone_nos_country_code() 
 
Dim olApp As Outlook.Application 
 
Dim myNameSpace As Outlook.NameSpace 
 
Dim objFolder As Outlook.MAPIFolder 
 
Dim objItems As Outlook.Items 
 
Dim objItem As Object, objAdd As Object 
 
Dim new_no As String 
 
'Loop through all the contacts 
 
Set olApp = CreateObject("Outlook.Application") 
 
Set myNameSpace = olApp.GetNamespace("MAPI") 
 
Set objFolder = myNameSpace.GetDefaultFolder(olFolderContacts) ' <-- Main (default) contacts folder 
 
' objFolder.ShowAsOutlookAB = True ' ticks box to see folder content items as contacts 
 
Set objItems = objFolder.Items 
 
For Each objItem In objItems 
 
' Make sure we have a contact item 
 
With objItem 
 
If .Class = olContact Then 
 
Debug.Print .FileAs, .BusinessTelephoneNumber, .HomeTelephoneNumber, .MobileTelephoneNumber 
 
> HomeTelephoneNumber = correct_phone_no_to_international(.HomeTelephoneNumber) 
 
> BusinessTelephoneNumber = correct_phone_no_to_international(.BusinessTelephoneNumber) 
 
> HomeTelephoneNumber = correct_phone_no_to_international(.HomeTelephoneNumber) 
 
> MobileTelephoneNumber = correct_phone_no_to_international(.MobileTelephoneNumber) 
 
> BusinessFaxNumber = correct_phone_no_to_international(.BusinessFaxNumber) 
 
objItem.Save 
 
End If 
 
End With 
 
Next 
 
End Sub 
 
'============================================= 
 
Function correct_phone_no_to_international(phone_no As String) As String 
 
Dim new_phone_no As String 
 
Dim my_country_code As String 
 
'****change this to your country code: 
 
my_country_code = "+44" 
 
'*********** 
 
correct_phone_no_to_international=phone_no 
 
If Len(Trim(phone_no)) = 0 Then
   change_phone_no_to_international = ""
   Exit Function 
 
End If 
 
If Left$(phone_no, 1) <> "+" Then
   new_phone_no = my_country_code + Mid$(phone_no, 2)
   correct_phone_no_to_international = new_phone_no 
 
End If 
 
End Function

 

[Jeghir]

Tutorial How to Inserting Please, Thank's....

 

[Diane Poremsky]

Do you need help using macros? See How to use VBA Editor.