Updating Outlook Contact Phone Nos to international dialling codes

Status
Not open for further replies.
Outlook version
Email Account
POP3
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!

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

Code:
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

Senior Member
Outlook version
Outlook 2010 64 bit
Email Account
Exchange Server
Thanks for posting this!
 
Outlook version
Email Account
POP3
There is a bug in the original code :( I tried to edit my post, but couldn't - corrected code below.

Code:
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
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
K Updating Contact Groups in Outlook 2010 Using Outlook 3
RBLampert Updating from Outlook 2010 to Outlook 365 Using Outlook 0
makinmyway Recent Files Not Updating when Using Insert Hyperlink in Outlook 2013 Using Outlook 0
M Outlook 10 Inbox not updating Using Outlook 3
H Gmail not updating Outlook Home Using Outlook 17
Aalishaan Outlook 2010 Updating Inbox starts again Using Outlook 0
J Shared ICalendars are not updating in Outlook Using Outlook 2
D Outlook 2010 - Pattern for updating task owner in generic mailbox Using Outlook 2
M Updating VBA code from outlook 2007 to outlook 2010 Using Outlook 1
Z Updating .ics files in OUtlook 2010 Using Outlook 1
J Outlook changing from inbox/trash/sent, etc. is EXTREMELY slow since updating Windows a couple of days ago. Is there an issue with Outlook as to the Using Outlook 2
R Outlook 2003 - Exchange 2010 global address list not updating Using Outlook 3
S Outlook calendar tracking not updating meeting acceptances Using Outlook 5
T Appoinments Not Updating after Outlook 2007 SP2 Outlook VBA and Custom Forms 1
D Custom Search Folders not refreshing/updating automatically Using Outlook 0
I Saving attachments from multiple emails and updating file name Outlook VBA and Custom Forms 0
G Updating VbaProject.OTM on several users Outlook VBA and Custom Forms 3
T Office 2013 no longer updating automatically Using Outlook 2
G Mass Updating Contact form used Outlook VBA and Custom Forms 8
J Updating existing entry on shared calendar wants to send update from delegate Using Outlook 0
K Can VBA intervene when updating Internet Calendars? Outlook VBA and Custom Forms 5
S Task Update coming as email and not updating task Using Outlook 3
M search takes a loooong time since updating Using Outlook 8
T Shared calendar not updating Using Outlook 1
T Need help with finding/updating task Outlook VBA and Custom Forms 1
P Updating Last Modified Date on ThisOutlookSession Macro Outlook VBA and Custom Forms 1
TotallyConfused Godaddy Microsoft exchange 2007 stopped updating Exchange Server Administration 1
S Updating the database based on received task Outlook VBA and Custom Forms 3
S Updating between Smartphone and PC Using Outlook 3
Alex Hall When updating shared calendar, it does not automatically update personal calendar Using Outlook 3
D Updating Registry to force new task and note items to save in a particular folder Using Outlook 1
K Excel Import Option: Need Help Updating Existing Records BCM (Business Contact Manager) 0
M Constantly updating address book Using Outlook 5
B Updating Macro to OL2010/32bit Using Outlook 8
D Multiple Users Updating Custom Form At Same Time Using Outlook 1
D Updating a recurring meeting cuses a reminder to be sent for every occurence. Using Outlook 2
C Message Count not updating Using Outlook 2
H Cannot share calendar, global address book not updating Exchange Server Administration 1
C Updating many contacts at once? BCM (Business Contact Manager) 3
H Calendar not updating accepted appointments! Using Outlook 1
D Updating Accounts in Business Contact Manager Using Outlook 1
S Global address book, 1 users not updating Using Outlook 2
S Error updating public folder with free/busy information on virtual machine server. The error number Using Outlook 2
T Error when updating Internet Calendar Subscriptions Using Outlook 12
A Updating contacts with new information BCM (Business Contact Manager) 1
M updating and saving contacts in Distribution List Outlook VBA and Custom Forms 2
M Updating appointments from Access 07 Outlook VBA and Custom Forms 4
S Outlook email to configure setup for each mail Outlook VBA and Custom Forms 0
witzker print-list-of-outlook-folders with sort posibility Outlook VBA and Custom Forms 7
witzker Open Contact missing in Outlook 2019 Using Outlook 2

Similar threads

Top