Tecnologias

Adicionando o dígito 9 aos números do prefixo 011

Recentemente uma resolução da ANATEL determinou que devemos adicionar o dígito 9 a todos números de celulares do prefixo 011. Esta tarefa feita manualmente seria um gigantesco transtorno para quem possui muitos registros, portanto o ideal é usar um script para tanto.

Como nem todos sabem criar estes scripts, disponibilizo aqui um para o Outlook 2010 (que também deve funcionar no 97, 2003 e 2011).

Detalhe MUITO importante:

Este código não funcionará para quem armazena o código da operadora antes do número do telefone! Neste caso use a orientação constante neste post.

Como utilizá-lo:

1. Abra o Outlook e pressione Alt + F11 para exibir o Editor do Visual Basic;

   

2. Nesta tela clique em Inserir e depois em Módulo;
3. Copie o código abaixo e cole ele na área à direita;

   

              

Sub AlteraTelefones()
  'Autor: Carlos Fernando Paleo da Rocha
  Dim objApp As Application
  Dim objNS As NameSpace
  Dim objFolder As MAPIFolder
  Dim objItems As Items
  Dim objItem As Object
  Dim newTel As String

  Set objApp = CreateObject("Outlook.Application")
  Set objNS = objApp.GetNamespace("MAPI")
  Set objFolder = objNS.PickFolder
  If Not objFolder Is Nothing Then
    Set objItems = objFolder.Items
    For Each objItem In objItems
        If Len(objItem.MobileTelephoneNumber) = 11 Or Len(objItem.MobileTelephoneNumber) = 10 Then
                newTel = LTrim(RTrim(Replace(Replace(Replace(Replace(RTrim(objItem.MobileTelephoneNumber), "(", ""), ")", ""), "-", ""), " ", "")))
                If Left(newTel, 3) = "011" Then
                    newTel = Left(newTel, 3) & 9 & Right(newTel, Len(newTel) - 3)
                    objItem.MobileTelephoneNumber = "(" & Left(newTel, 3) & ") " & Right(newTel, Len(newTel) - 3)
                    objItem.Save
                ElseIf Left(newTel, 2) = "11" Then
                    newTel = Left(newTel, 2) & 9 & Right(newTel, Len(newTel) - 2)
                    objItem.MobileTelephoneNumber = "(" & Left(newTel, 2) & ") " & Right(newTel, Len(newTel) - 2)
                    objItem.Save
                End If
        End If
    Next
  End If
  Set objItems = Nothing
  Set objItem = Nothing
  Set objFolder = Nothing
  Set objNS = Nothing
  Set objApp = Nothing
End Sub



4. Pronto, o processo é super rápido e seus telefones já estarão ajustados. Agora é só sincronizar o celular com o Outlook para ter todos telefones dele corrigidos também!

Published segunda-feira, 30 de julho de 2012 14:57 by Paleo