Results 1 to 1 of 1
  1. #1
    New Lounger
    Join Date
    Jul 2013
    Thanked 0 Times in 0 Posts

    Updating Outlook Contact Phone Nos to international dialling codes

    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 this forum,

    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 in the contacts folder, and see if we
    ' have a match with the LastName and FirstName in the current line,
    ' and if so, update that contact's data
    ' TODO: Find out if there's some way to find a matching LastName and FirstName
    ' in Outlook VBA without having to loop through everything, like maybe an
    ' equivalent for the FindFirst method in Access VBA?
    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.BusinessTelephoneNumber = strBusPhone$
    'objItem.MobileTelephoneNumber = strMobilePhone$
    'objItem.Email1Address = strEmail1$
    End If
    End With
    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
    Last edited by AndrewDJohnson; 2013-07-08 at 05:23.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts