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
P Outlook tasks keeps changing (updating) dates that I type Using Outlook 2
I Outlook is stuck at "Updating Calendar" Using Outlook 1
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
R Outlook 2003 - Exchange 2010 global address list not updating Using Outlook 3
T Appoinments Not Updating after Outlook 2007 SP2 Outlook VBA and Custom Forms 1
A VBscript stops running after updating form 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
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
N Can't create NEW GROUP and add/remove a member from existing Group in Outlook Using Outlook 1
M I cant send emails via Outlook in my W10 PC. Using Outlook 3
A Outlook Reminders not populating for certain events Using Outlook 2
O Moving "tasks" to inbox in Outlook 2016 Using Outlook 1
S HTML Code Embedded in String Within Open Outlook Email Preventing Replace(Application.ActiveInspector.CurrentItem.HTMLBody From Working Outlook VBA and Custom Forms 4
e_a_g_l_e_p_i Can emails from Gmail be deleted when they are downloaded to Outlook 2010 Using Outlook 1
cbufacchi Outlook 365 Populate custom Outlook Appoint form Outlook VBA and Custom Forms 2

Similar threads

Top