Alteração em massa prefixo Tel no Outlook

(nova revisão incluindo Macro que insere o "9" para celulares em SP, atualizado em 16/08/2012 com simplificação do uso, apenas 2 macros)

Recentemente a Claro, sem aviso prévio, bloqueou o uso de prefixo + para efetuar ligações em sua rede. Entendo ser um padrão internacional e a Claro não está sendo inteligente em fazer isso. Para mim era uma "mão na roda" pois cadastro meus contatos com +55 XX YYY YYYY assim quando viajo para o exterior não preciso alterar nada. Deve ser um parto também para os estrangeiros que vem para o Brasil...

Neste post apresentam-se 2 Macros VBA que alteram em massa, todos os telefones de todos os contatos da pasta selecionada, apenas modifiquei um Macro existente na Internet que fazia algo similar.

• Macro "Add9toSPPhones" adiciona o digito "9" nos telefones celulares com prefixo "11"
• Macro "ChangeP55x021" troca +55 por 021 no inicio de todos os telefones

Testei no meu Outlook 2003 que tinha mais de 700 contatos e funcionou bem. O Macro não altera telefones com outros prefixos, como +52, +1, etc.

(Thanks to Diane Poremsky who wrote the original code.)

Instruções de Instalação:

1. No Outlook entre no Menu "Tools>Macro>Visual Basic Editor", o Editor de Macros vai abrir.
2. Clique com o botão da direita do Mouse sobre "Project1" na árvore de projetos e selecione "Insert>Module". Uma pasta "Modules" com um container "Module1" serão criados.
3. Copie e cole o código fonte abaixo, neste post, para dentro do "Module1".
4. Salve o projeto, Menu "File>Save" ou aperte o botão Save.

 Uso do Macro +55 para 021:

1.  Ir para Contatos e Selecionar o grupo de contatos desejado, normalmente o "Contacts", mas eu criei um grupo "Teste" e movi para este alguns contatos, não todos, desta forma pode-se testar o Macro.
2. Com o grupo de contatos selecionado tecle Alt-F8 e a tela de Macros vai surgir. 
3. Selecione o Macro "ChangeP55x021" Pressione "Run". Ver figura abaixo.
4. A alteração em massa não deve demorar, para 700 contatos tomou uns 30 segundos.
5. Verifique os contatos, todos os +55 devem ter sido substituidos por 021.
6. Se quiser voltar de 021 para +55 basta inverter estes dados na subrotina "ReplacePrefix" no código fonte.

 Uso do Macro insere algarismo "9" nos celulares da regiao 11:

1. Ir para Contatos e Selecionar o grupo de contatos desejado, normalmente o "Contacts", mas eu criei um grupo "Teste" e movi para este alguns contatos, não todos, desta forma pode-se testar o Macro.
2. Com o grupo de contatos selecionado tecle Alt-F8 e a tela de Macros vai surgir. 
3. Selecione o Macro "Add9toSPPhones" Pressione "Run"
4. Este Macro não altera qualquer digito antes do prefixo "11"

Abraços

Alex

=====================Código Fonte============================

Sub Add9toSPPhones()

Dim Counter As Integer

'Alexandre Magno 2012
'Add "9" in front of the 8th digit in the mobile # preceded by "11"
'does not change any other digit before "11" if exist

'Cleaning up non numeric characters from all contact numbers
Counter = CleanPhone()
Counter = FixPhone9Format()
MsgBox "Contatos Processados: " & Counter, vbInformation


End Sub
Private Function FixPhone9Format() As Integer

 
Dim oFolder As MAPIFolder
 Set oFolder = Application.ActiveExplorer.CurrentFolder
 
' Confirm it's a contacts folder by looking at the default form name
' to see if it begins with "ipm.contact".
' This allows it to work on folders with custom forms
 If Left(UCase(oFolder.DefaultMessageClass), 11) <> "IPM.CONTACT" Then
 MsgBox "Selecione uma pasta de contatos...", vbExclamation
 Exit Function
 End If
 
Dim nCounter As Integer
 nCounter = 0
 
'MagnoForm.Show
 
Dim oItem
 For Each oItem In oFolder.Items
 Dim oContact As ContactItem
 
' If the current item is a not a Contact Group process the phone numbers
' If it's a DL, the code moves on to the next item
 If TypeName(oItem) <> "DistListItem" Then
 
 Set oContact = oItem
 With oContact
 '.AssistantTelephoneNumber = ReplacePrefix(.AssistantTelephoneNumber)
 '.Business2TelephoneNumber = ReplacePrefix(.Business2TelephoneNumber)
 '.BusinessFaxNumber = ReplacePrefix(.BusinessFaxNumber)
 '.BusinessTelephoneNumber = ReplacePrefix(.BusinessTelephoneNumber)
 '.CallbackTelephoneNumber = ReplacePrefix(.CallbackTelephoneNumber)
 '.CarTelephoneNumber = ReplacePrefix(.CarTelephoneNumber)
 '.CompanyMainTelephoneNumber = ReplacePrefix(.CompanyMainTelephoneNumber)
 '.Home2TelephoneNumber = ReplacePrefix(.Home2TelephoneNumber)
 '.HomeFaxNumber = ReplacePrefix(.HomeFaxNumber)
 '.HomeTelephoneNumber = ReplacePrefix(.HomeTelephoneNumber)
 '.ISDNNumber = ReplacePrefix(.ISDNNumber)
 .MobileTelephoneNumber = Replace9Prefix(.MobileTelephoneNumber)
 '.OtherFaxNumber = ReplacePrefix(.OtherFaxNumber)
 '.OtherTelephoneNumber = ReplacePrefix(.OtherTelephoneNumber)
 '.PagerNumber = ReplacePrefix(.PagerNumber)
 '.PrimaryTelephoneNumber = ReplacePrefix(.PrimaryTelephoneNumber)
 '.RadioTelephoneNumber = ReplacePrefix(.RadioTelephoneNumber)
 '.TelexNumber = ReplacePrefix(.TelexNumber)
 '.TTYTDDTelephoneNumber = ReplacePrefix(.TTYTDDTelephoneNumber)
 
.Save
 
 'MagnoForm.TextBox1.Text = nCounter
 'MsgBox "Contato Processado=" & nCounter, vbInformation
 
nCounter = nCounter + 1
 End With
 End If
 Next
 
FixPhone9Format = nCounter

End Function


Private Function CleanPhone() As Integer
 
Dim oFolder As MAPIFolder
 Set oFolder = Application.ActiveExplorer.CurrentFolder
 
' Confirm it's a contacts folder by looking at the default form name
' to see if it begins with "ipm.contact".
' This allows it to work on folders with custom forms
 If Left(UCase(oFolder.DefaultMessageClass), 11) <> "IPM.CONTACT" Then
 MsgBox "Selecione uma pasta de contatos...", vbExclamation
 Exit Function
 End If
 
Dim nCounter As Integer
 nCounter = 0
 
'MagnoForm.Show
 
Dim oItem
 For Each oItem In oFolder.Items
 Dim oContact As ContactItem
 
' If the current item is a not a Contact Group process the phone numbers
' If it's a DL, the code moves on to the next item
 If TypeName(oItem) <> "DistListItem" Then
 
 Set oContact = oItem
 With oContact
 .AssistantTelephoneNumber = CleanNumber(.AssistantTelephoneNumber)
 .Business2TelephoneNumber = CleanNumber(.Business2TelephoneNumber)
 .BusinessFaxNumber = CleanNumber(.BusinessFaxNumber)
 .BusinessTelephoneNumber = CleanNumber(.BusinessTelephoneNumber)
 .CallbackTelephoneNumber = CleanNumber(.CallbackTelephoneNumber)
 .CarTelephoneNumber = CleanNumber(.CarTelephoneNumber)
 .CompanyMainTelephoneNumber = CleanNumber(.CompanyMainTelephoneNumber)
 .Home2TelephoneNumber = CleanNumber(.Home2TelephoneNumber)
 .HomeFaxNumber = CleanNumber(.HomeFaxNumber)
 .HomeTelephoneNumber = CleanNumber(.HomeTelephoneNumber)
 .ISDNNumber = CleanNumber(.ISDNNumber)
 .MobileTelephoneNumber = CleanNumber(.MobileTelephoneNumber)
 .OtherFaxNumber = CleanNumber(.OtherFaxNumber)
 .OtherTelephoneNumber = CleanNumber(.OtherTelephoneNumber)
 .PagerNumber = CleanNumber(.PagerNumber)
 .PrimaryTelephoneNumber = CleanNumber(.PrimaryTelephoneNumber)
 .RadioTelephoneNumber = CleanNumber(.RadioTelephoneNumber)
 .TelexNumber = CleanNumber(.TelexNumber)
 .TTYTDDTelephoneNumber = CleanNumber(.TTYTDDTelephoneNumber)
 
.Save
 
 'MagnoForm.TextBox1.Text = nCounter
 'MsgBox "Contato Processado=" & nCounter, vbInformation
 
nCounter = nCounter + 1
 End With
 End If
 Next
 
CleanPhone = nCounter

End Function

Private Function Replace9Prefix(strPhone As String) As String
 'originalmente FixFormat, modificado para ReplacePrefix by Magno 2012
 strPhone = Trim(strPhone)
 Replace9Prefix = strPhone
 If strPhone = "" Then Exit Function
 If Len(strPhone) < 10 Then Exit Function ' no change in # with no area code or small #
 
 Dim the9Digit, the10Digit As String
 
 the9Digit = Right(strPhone, 9) 'get mobile # + 1 char
 the9Digit = Left(the9Digit, 1) 'get the 9th digit
 If the9Digit <> "1" Then Exit Function
 
 the10Digit = Right(strPhone, 10) 'get mobile # + 1 char
 the10Digit = Left(the10Digit, 1) 'get the 10th digit
 If the10Digit <> "1" Then Exit Function
 
 strPhone = Left(strPhone, Len(strPhone) - 8) + "9" + Right(strPhone, 8)
 
 
 'MsgBox "telefone=" & strPhone
 
' After replace the country code, we remove non-numeric characters
' Can be tweaked to change formatting, ie: change 202.555.1212 to 202-555-1212
 
 strPhone = Replace(strPhone, "(", "")
 strPhone = Replace(strPhone, ")", "")
 strPhone = Replace(strPhone, ".", "")
 strPhone = Replace(strPhone, " ", "")
 strPhone = Replace(strPhone, "-", "")
 
Replace9Prefix = strPhone
 
End Function

Sub ChangeP55x021()
 
Dim oFolder As MAPIFolder
 Set oFolder = Application.ActiveExplorer.CurrentFolder
 
' Confirm it's a contacts folder by looking at the default form name
' to see if it begins with "ipm.contact".
' This allows it to work on folders with custom forms
 If Left(UCase(oFolder.DefaultMessageClass), 11) <> "IPM.CONTACT" Then
 MsgBox "Selecione uma pasta de contatos...", vbExclamation
 Exit Sub
 End If
 
Dim nCounter As Integer
 nCounter = 0
 
'MagnoForm.Show
 
Dim oItem
 For Each oItem In oFolder.Items
 Dim oContact As ContactItem
 
' If the current item is a not a Contact Group process the phone numbers
' If it's a DL, the code moves on to the next item
 If TypeName(oItem) <> "DistListItem" Then
 
 Set oContact = oItem
 With oContact
 .AssistantTelephoneNumber = ReplacePrefix(.AssistantTelephoneNumber)
 .Business2TelephoneNumber = ReplacePrefix(.Business2TelephoneNumber)
 .BusinessFaxNumber = ReplacePrefix(.BusinessFaxNumber)
 .BusinessTelephoneNumber = ReplacePrefix(.BusinessTelephoneNumber)
 .CallbackTelephoneNumber = ReplacePrefix(.CallbackTelephoneNumber)
 .CarTelephoneNumber = ReplacePrefix(.CarTelephoneNumber)
 .CompanyMainTelephoneNumber = ReplacePrefix(.CompanyMainTelephoneNumber)
 .Home2TelephoneNumber = ReplacePrefix(.Home2TelephoneNumber)
 .HomeFaxNumber = ReplacePrefix(.HomeFaxNumber)
 .HomeTelephoneNumber = ReplacePrefix(.HomeTelephoneNumber)
 .ISDNNumber = ReplacePrefix(.ISDNNumber)
 .MobileTelephoneNumber = ReplacePrefix(.MobileTelephoneNumber)
 .OtherFaxNumber = ReplacePrefix(.OtherFaxNumber)
 .OtherTelephoneNumber = ReplacePrefix(.OtherTelephoneNumber)
 .PagerNumber = ReplacePrefix(.PagerNumber)
 .PrimaryTelephoneNumber = ReplacePrefix(.PrimaryTelephoneNumber)
 .RadioTelephoneNumber = ReplacePrefix(.RadioTelephoneNumber)
 .TelexNumber = ReplacePrefix(.TelexNumber)
 .TTYTDDTelephoneNumber = ReplacePrefix(.TTYTDDTelephoneNumber)
 
.Save
 
 'MagnoForm.TextBox1.Text = nCounter
 'MsgBox "Contato Processado=" & nCounter, vbInformation
 
nCounter = nCounter + 1
 End With
 End If
 Next
 
MsgBox "Contatos Processados: " & nCounter, vbInformation
'MagnoForm.Hide

End Sub
 

Private Function CleanNumber(strPhone As String) As String
 'originalmente FixFormat, modificado para ReplacePrefix by Magno 2012
 strPhone = Trim(strPhone)
 CleanNumber = strPhone
 If strPhone = "" Then Exit Function
 
 Dim prefix As String
 prefix = Left(strPhone, 1) 'for future use
 
'Can be tweaked to change formatting, ie: change 202.555.1212 to 202-555-1212
 
 strPhone = Replace(strPhone, "(", "")
 strPhone = Replace(strPhone, ")", "")
 strPhone = Replace(strPhone, ".", "")
 strPhone = Replace(strPhone, " ", "")
 strPhone = Replace(strPhone, "-", "")
 
CleanNumber = strPhone
 
End Function
Private Function ReplacePrefix(strPhone As String) As String
 'originalmente FixFormat, modificado para ReplacePrefix by Magno 2012
 strPhone = Trim(strPhone)
 ReplacePrefix = strPhone
 If strPhone = "" Then Exit Function
 
 Dim prefix As String
 prefix = Left(strPhone, 1) 'for future use
 
 strPhone = Replace(strPhone, "+55", "021", 1)
 
 'MsgBox "telefone=" & strPhone
 
' After replace the country code, we remove non-numeric characters
' Can be tweaked to change formatting, ie: change 202.555.1212 to 202-555-1212
 
 strPhone = Replace(strPhone, "(", "")
 strPhone = Replace(strPhone, ")", "")
 strPhone = Replace(strPhone, ".", "")
 strPhone = Replace(strPhone, " ", "")
 strPhone = Replace(strPhone, "-", "")
 
ReplacePrefix = strPhone
 
End Function