Ajouter automatiquement 33 devant tous les numéros de mes contact outlook

Signaler
Messages postés
1
Date d'inscription
jeudi 11 mai 2006
Statut
Membre
Dernière intervention
8 octobre 2007
-
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
-
Salut tout le monde,
Je cherche une solution pour pouvoir mettre devant les numéros de mes contacts outlook le no,bre 33. En fait le sénégal a changer la numérotation depuis hier et il faut rajouter 33 devant les numéros fixes. Je pense qu'il y a un moyen d'automatiser cela avec vba outlook
Merci si quelqu'un peut m'aider
jm

1 réponse

Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
18
Salut,
Tu n'es pas obligé de passer par Outlook... Tu pourrais aussi bien le faire à partir de VB ou Excel ou autre application dans laquelle tu crées une référence à Outlook.

Voici un exemple de code. Il faut savoir qu'il existe une panoplie de numéro de téléphone dans Outlook (domicile, domicile 2, bureau, bureau 2, portable, ...)
À toi de fouiller lesquels doivent être changés.

    Dim objApp As New Outlook.Application
    Dim objNameSpace As Outlook.NameSpace
    Dim objContact As MAPIFolder
    Dim Entite As ContactItem
   
    Set objNameSpace = objApp.GetNamespace(Type:="MAPI")
    Set objContact = objNameSpace.GetDefaultFolder(olFolderContacts)
   
    On Error Resume Next
   
    For Each Entite In objContact.Items
        If Not Entite Is Nothing Then
            If Left(CStr(Entite.BusinessTelephoneNumber), 2) <> "33" Then _
                Entite.BusinessTelephoneNumber = "33" & Entite.BusinessTelephoneNumber
            If Left(CStr(Entite.HomeTelephoneNumber), 2) <> "33" Then _
                Entite.HomeTelephoneNumber = "33" & Entite.HomeTelephoneNumber
            If Left(CStr(Entite.MobileTelephoneNumber), 2) <> "33" Then _
                Entite.MobileTelephoneNumber = "33" & Entite.MobileTelephoneNumber
        End If
        Entite.Save
    Next
   
    Set objContact = Nothing
    Set objNameSpace = Nothing
    Set objApp = Nothing

MPi²