Bom, um codigo que me foi passado, se nao me engano foi desenvolvido por alguem de windows phone (Mário Abreu)
nao testei, mas aparenta fazer as verificações necessarias.
Sub ResolveOperadora()
Dim oFolder As MAPIFolder
Set oFolder = Application.ActiveExplorer.CurrentFolder
If Left(UCase(oFolder.DefaultMessageClass), 11) <> "IPM.CONTACT" Then
MsgBox "Selecione pasta de contatos", vbExclamation
Exit Sub
End If
Dim Contador As Integer
Dim Operadora As String
Dim Area As String
Contador = 0
pedeOperadora:
Operadora = InputBox(Prompt:="Digite o codigo de sua operadora de longa distancia:", _
Title:="Digite sua operadora:", Default:="00")
testaOperadora:
If Operadora = vbNullString Then Exit Sub
If Operadora = "00" Or _
Operadora = "" Then
Operadora = InputBox(Prompt:="Digite Algum valor:", _
Title:="Digite sua operadora:", Default:="00")
GoTo testaOperadora
Else
If (Len(Operadora) > 2) Or _
(Len(Operadora) < 2) Or _
IsNumeric(Operadora) = False Then
MsgBox "Operadora deve ser dois digitos númericos!", vbError
GoTo pedeOperadora
End If
End If
pedeArea:
Area = InputBox(Prompt:="Digite o codigo de area de sua cidade:", _
Title:="Digite seu codigo de Area:", Default:="00")
testaArea:
If Area = vbNullString Then Exit Sub
If Area = "00" Or _
Area = "" Then
Area = InputBox(Prompt:="Digite Algum valor:", _
Title:="Digite seu codigo de Area:", Default:="00")
GoTo testaArea
Else
If (Len(Area) > 2) Or _
(Len(Area) < 2) Or _
IsNumeric(Area) = False Then
MsgBox "Codigo de Area deve ser dois digitos númericos!", vbError
GoTo pedeArea
End If
End If
On Error GoTo handle
MsgBox "Ao clicar em OK o Processo de alteraçao comecará. Seu Outlook Permanecerá em um estado " & _
"não responsivo até o termino onde uma mensagem informará o numero de contatos processados.", vbInformation
Dim oItem
For Each oItem In oFolder.Items
Dim oContact As ContactItem
Set oContact = oItem
If Not oContact Is Nothing Then
With oContact
.AssistantTelephoneNumber = CorrigeNumeros(.AssistantTelephoneNumber, Operadora, Area)
.Business2TelephoneNumber = CorrigeNumeros(.Business2TelephoneNumber, Operadora, Area)
.BusinessFaxNumber = CorrigeNumeros(.BusinessFaxNumber, Operadora, Area)
.BusinessTelephoneNumber = CorrigeNumeros(.BusinessTelephoneNumber, Operadora, Area)
.CallbackTelephoneNumber = CorrigeNumeros(.CallbackTelephoneNumber, Operadora, Area)
.CarTelephoneNumber = CorrigeNumeros(.CarTelephoneNumber, Operadora, Area)
.CompanyMainTelephoneNumber = CorrigeNumeros(.CompanyMainTelephoneNumber, Operadora, Area)
.Home2TelephoneNumber = CorrigeNumeros(.Home2TelephoneNumber, Operadora, Area)
.HomeFaxNumber = CorrigeNumeros(.HomeFaxNumber, Operadora, Area)
.HomeTelephoneNumber = CorrigeNumeros(.HomeTelephoneNumber, Operadora, Area)
.ISDNNumber = CorrigeNumeros(.ISDNNumber, Operadora, Area)
.MobileTelephoneNumber = CorrigeNumeros(.MobileTelephoneNumber, Operadora, Area)
.OtherFaxNumber = CorrigeNumeros(.OtherFaxNumber, Operadora, Area)
.OtherTelephoneNumber = CorrigeNumeros(.OtherTelephoneNumber, Operadora, Area)
.PagerNumber = CorrigeNumeros(.PagerNumber, Operadora, Area)
.PrimaryTelephoneNumber = CorrigeNumeros(.PrimaryTelephoneNumber, Operadora, Area)
.RadioTelephoneNumber = CorrigeNumeros(.RadioTelephoneNumber, Operadora, Area)
.TelexNumber = CorrigeNumeros(.TelexNumber, Operadora, Area)
.TTYTDDTelephoneNumber = CorrigeNumeros(.TTYTDDTelephoneNumber, Operadora, Area)
.Save
Contador = Contador + 1
End With
End If
nextItem:
Next
MsgBox Contador & " contatos processados.", vbInformation
Exit Sub
handle:
Resume nextItem
End Sub
Public Function CorrigeNumeros(strNumero As String, strOperadora As String, strArea As String) As String
Dim Corrigido As String
Dim Ramal As String
Dim ValidaRamal As Integer
Corrigido = ""
Ramal = ""
strNumero = Trim(strNumero)
CorrigeNumeros = strNumero
If strNumero = "" Then Exit Function
strNumero = Replace(strNumero, " ", "")
strNumero = Replace(strNumero, "(", "")
strNumero = Replace(strNumero, ")", "")
strNumero = Replace(strNumero, ".", "")
strNumero = Replace(strNumero, ",", "")
strNumero = Replace(strNumero, "-", "")
ValidaRamal = InStr(strNumero, "X")
If Not IsNull(ValidaRamal) Then
If ValidaRamal > 0 Then
Ramal = Mid(strNumero, ValidaRamal)
strNumero = Left(strNumero, ValidaRamal - 1)
End If
End If
If Left(strNumero, 1) = "+" Then 'Testa se formato E.163
If Left(strNumero, 3) = "+55" Then 'Testa se for do Brasil
If Right(Left(strNumero, 5), 2) = "11" Then
If Right(Left(strNumero, 6), 1) = "6" Or Right(Left(strNumero, 6), 1) = "7" Or Right(Left(strNumero, 6), 1) = "8" Or Right(Left(strNumero, 6), 1) = "9" Then
Corrigido = "0" & strOperadora & "119" & Mid(strNumero, 6) 'Corrige com um 9 extra para Sao Paulo
Else
Corrigido = "0" & strOperadora & Mid(strNumero, 4)
End If
Else
Corrigido = "0" & strOperadora & Mid(strNumero, 4)
End If
Corrigido = "0" & strOperadora & Mid(strNumero, 4)
Else
Corrigido = "00" & strOperadora & Mid(strNumero, 2)
End If
ElseIf Left(strNumero, 2) = "00" Then 'Testa se padrão internacional
Corrigido = "00" & strOperadora & Mid(strNumero, 5)
ElseIf Len(strNumero) = 10 Then 'Testa se for americano sem digitos e corrige a discagem
Corrigido = "00" & strOperadora & "1" & strNumero
ElseIf Len(strNumero) = 8 Then 'Testa se for local com 8 digitos
If strArea = "11" Then
If Left(strNumero, 1) = "6" Or Left(strNumero, 1) = "7" Or Left(strNumero, 1) = "8" Or Left(strNumero, 1) = "9" Then
Corrigido = "0" & strOperadora & strArea & "9" & strNumero 'Corrige com um 9 extra para Sao Paulo
Else
Corrigido = "0" & strOperadora & strArea & strNumero
End If
Else
Corrigido = "0" & strOperadora & strArea & strNumero
End If
ElseIf Len(strNumero) = 9 Then 'Testa se for local com 9 digitos
If strArea = "11" Then
If Left(strNumero, 1) = "6" Or Left(strNumero, 1) = "7" Or Left(strNumero, 1) = "8" Or Left(strNumero, 1) = "9" Then
Corrigido = "0" & strOperadora & strArea & "9" & strNumero 'Corrige com um 9 extra para Sao Paulo
Else
Corrigido = "0" & strOperadora & strArea & strNumero
End If
Else
Corrigido = "0" & strOperadora & strArea & strNumero
End If
ElseIf Len(strNumero) = 13 Then 'Testa se esta no formato operadora
If Right(Left(strNumero, 5), 2) = "11" Then
If Right(Left(strNumero, 6), 1) = "6" Or Right(Left(strNumero, 6), 1) = "7" Or Right(Left(strNumero, 6), 1) = "8" Or Right(Left(strNumero, 6), 1) = "9" Then
Corrigido = "0" & strOperadora & "119" & Mid(strNumero, 6) 'Corrige com um 9 extra para Sao Paulo
Else
Corrigido = "0" & strOperadora & Mid(strNumero, 4)
End If
Else
Corrigido = "0" & strOperadora & Mid(strNumero, 4)
End If
ElseIf Len(strNumero) = 14 Then 'Testa se esta no formato operadora
If Right(Left(strNumero, 5), 2) = "11" Then
Corrigido = "0" & strOperadora & Mid(strNumero, 4)
End If
ElseIf Left(strNumero, 4) = "55" & strArea Then ' Corrige contatos sem + do Brasil
Corrigido = "0" & strOperadora & Mid(strNumero, 3)
Else
Corrigido = strNumero
End If
If Corrigido = "" Then Exit Function
If Not IsNull(ValidaRamal) Then
If ValidaRamal > 0 Then
CorrigeNumeros = Corrigido & Ramal
Else
CorrigeNumeros = Corrigido
End If
Else
CorrigeNumeros = Corrigido
End If
End Function
Public Function IsNumericOnly(TestString As String) As Boolean
Dim sTemp As String
Dim iLen As Integer
Dim iCtr As Integer
Dim sChar As String
'returns true if all characters in string are numeric
'returns false otherwise or for empty string
'this is different than VB's isNumeric
'isNumeric returns true for something like 90.09
'This function will return false
sTemp = TestString
iLen = Len(sTemp)
If iLen > 0 Then
For iCtr = 1 To iLen
sChar = Mid(sTemp, iCtr, 1)
If Not sChar Like "[0-9]" Then Exit Function
Next
IsNumericOnly = True
End If
End Function
Foi util? Classifique ^^ MCP - MCDST - MCTS - MCSA - MCITP www.nrv.com.br www.alexandrenakagawa.com.br
