Attribute VB_Name = "Module2"
Sub ChangePhonePrefix()
    Dim myOlApp As Outlook.Application
    Dim myNms As Outlook.NameSpace
    Dim myFolder As Outlook.MAPIFolder
    Dim colContactItems As Outlook.Items
    Dim myContactItem As Outlook.ContactItem
    Dim SearchChar, pos, prefix
    
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNms = myOlApp.GetNamespace("MAPI")
    Set myFolder = myNms.GetDefaultFolder(olFolderContacts)
    Set colContactItems = myFolder.Items
    
    SearchChar = "8"
    prefix = "+3"
    
    For Each myContactItem In colContactItems
      If InStr(myContactItem.BusinessTelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.BusinessTelephoneNumber
           myContactItem.BusinessTelephoneNumber = phone
      End If
      If InStr(myContactItem.AssistantTelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.AssistantTelephoneNumber
           myContactItem.AssistantTelephoneNumber = phone
      End If
      If InStr(myContactItem.Business2TelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.Business2TelephoneNumber
           myContactItem.Business2TelephoneNumber = phone
      End If
      If InStr(myContactItem.CallbackTelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.CallbackTelephoneNumber
           myContactItem.CallbackTelephoneNumber = phone
      End If
      If InStr(myContactItem.CarTelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.CarTelephoneNumber
           myContactItem.CarTelephoneNumber = phone
      End If
      If InStr(myContactItem.CompanyMainTelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.CompanyMainTelephoneNumber
           myContactItem.CompanyMainTelephoneNumber = phone
      End If
      If InStr(myContactItem.Home2TelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.Home2TelephoneNumber
           myContactItem.Home2TelephoneNumber = phone
      End If
      If InStr(myContactItem.HomeTelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.HomeTelephoneNumber
           myContactItem.HomeTelephoneNumber = phone
      End If
      If InStr(myContactItem.MobileTelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.MobileTelephoneNumber
           myContactItem.MobileTelephoneNumber = phone
      End If
      If InStr(myContactItem.OtherTelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.OtherTelephoneNumber
           myContactItem.OtherTelephoneNumber = phone
      End If
      If InStr(myContactItem.PrimaryTelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.PrimaryTelephoneNumber
           myContactItem.PrimaryTelephoneNumber = phone
      End If
      If InStr(myContactItem.RadioTelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.RadioTelephoneNumber
           myContactItem.RadioTelephoneNumber = phone
      End If
      If InStr(myContactItem.TTYTDDTelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.TTYTDDTelephoneNumber
           myContactItem.TTYTDDTelephoneNumber = phone
      End If
      If InStr(myContactItem.Business2TelephoneNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.Business2TelephoneNumber
           myContactItem.Business2TelephoneNumber = phone
      End If
      If InStr(myContactItem.BusinessFaxNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.BusinessFaxNumber
           myContactItem.BusinessFaxNumber = phone
      End If
      If InStr(myContactItem.HomeFaxNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.HomeFaxNumber
           myContactItem.HomeFaxNumber = phone
      End If
      If InStr(myContactItem.OtherFaxNumber, SearchChar) = 1 Then
           phone = prefix + myContactItem.OtherFaxNumber
           myContactItem.OtherFaxNumber = phone
      End If
        
    myContactItem.Save
    Next
 End Sub