Option Explicit Dim Compteur As Integer Dim JournalMiseAJour As String Sub MajContacts() ' Je me suis inspiré de ce bout de code pour créer cette macro : ' http://www.developpez.net/forums/d669268/hardware-systemes-logiciels/microsoft-office/outlook/vba-outlook/extraction-contacts-to-txt/ Dim Rep As Byte Dim oCont As ContactItem Dim oFold As MAPIFolder Dim nM As NameSpace Dim olApp As Outlook.Application Set olApp = Outlook.Application Set nM = olApp.GetNamespace("MAPI") Set oFold = nM.GetDefaultFolder(olFolderContacts) Rep = MsgBox("Balayer le répertoire et remplacer l'indicatif du Maroc '+212' par '0' ?" _ & vbCrLf & "Exemple : '+21268XXXXXX' deviendra '068XXXXXX'" _ & vbCrLf & "Répondez par 'Non', si vous voulez ignorer cette vérification." _ , vbQuestion + vbYesNo) If Rep = vbYes Then Call Enleve212 'Else ' Exit Sub End If Compteur = 0 JournalMiseAJour = "Mise à jour des numéros des contacts via une macro Outlook." & vbCrLf JournalMiseAJour = JournalMiseAJour & "Selon la nouvelle numérotation téléphonique appliquée au Maroc le 07/03/09" & vbCrLf JournalMiseAJour = JournalMiseAJour & "Par Nabil KAROUACH, http://karouach.com" & vbCrLf & vbCrLf JournalMiseAJour = JournalMiseAJour & "Traitement lancé le " & Date & " à " & Time & vbCrLf & vbCrLf For Each oCont In oFold.Items Compteur = Compteur + 1 If Len(oCont.MobileTelephoneNumber) = 9 Then oCont.MobileTelephoneNumber = Insere6ou5(oCont.MobileTelephoneNumber, oCont.FullName) If Len(oCont.HomeTelephoneNumber) = 9 Then oCont.HomeTelephoneNumber = Insere6ou5(oCont.HomeTelephoneNumber, oCont.FullName) If Len(oCont.Business2TelephoneNumber) = 9 Then oCont.Business2TelephoneNumber = Insere6ou5(oCont.Business2TelephoneNumber, oCont.FullName) If Len(oCont.BusinessFaxNumber) = 9 Then oCont.BusinessFaxNumber = Insere6ou5(oCont.BusinessFaxNumber, oCont.FullName) If Len(oCont.BusinessTelephoneNumber) = 9 Then oCont.BusinessTelephoneNumber = Insere6ou5(oCont.BusinessTelephoneNumber, oCont.FullName) If Len(oCont.CompanyMainTelephoneNumber) = 9 Then oCont.CompanyMainTelephoneNumber = Insere6ou5(oCont.CompanyMainTelephoneNumber, oCont.FullName) If Len(oCont.Home2TelephoneNumber) = 9 Then oCont.Home2TelephoneNumber = Insere6ou5(oCont.Home2TelephoneNumber, oCont.FullName) If Len(oCont.HomeFaxNumber) = 9 Then oCont.HomeFaxNumber = Insere6ou5(oCont.HomeFaxNumber, oCont.FullName) If Len(oCont.OtherFaxNumber) = 9 Then oCont.OtherFaxNumber = Insere6ou5(oCont.OtherFaxNumber, oCont.FullName) If Len(oCont.OtherTelephoneNumber) = 9 Then oCont.OtherTelephoneNumber = Insere6ou5(oCont.OtherTelephoneNumber, oCont.FullName) If Len(oCont.PrimaryTelephoneNumber) = 9 Then oCont.PrimaryTelephoneNumber = Insere6ou5(oCont.PrimaryTelephoneNumber, oCont.FullName) oCont.Save Next JournalMiseAJour = JournalMiseAJour & vbCrLf & "Terminé à " & Time & vbCrLf & vbCrLf JournalNote (JournalMiseAJour) End Sub Sub Enleve212() Dim oCont As ContactItem Dim oFold As MAPIFolder Dim nM As NameSpace Dim olApp As Outlook.Application Set olApp = Outlook.Application Set nM = olApp.GetNamespace("MAPI") Set oFold = nM.GetDefaultFolder(olFolderContacts) For Each oCont In oFold.Items oCont.MobileTelephoneNumber = Anti212(oCont.MobileTelephoneNumber) oCont.HomeTelephoneNumber = Anti212(oCont.HomeTelephoneNumber) oCont.Business2TelephoneNumber = Anti212(oCont.Business2TelephoneNumber) oCont.BusinessFaxNumber = Anti212(oCont.BusinessFaxNumber) oCont.BusinessTelephoneNumber = Anti212(oCont.BusinessTelephoneNumber) oCont.CompanyMainTelephoneNumber = Anti212(oCont.CompanyMainTelephoneNumber) oCont.Home2TelephoneNumber = Anti212(oCont.Home2TelephoneNumber) oCont.HomeFaxNumber = Anti212(oCont.HomeFaxNumber) oCont.OtherFaxNumber = Anti212(oCont.OtherFaxNumber) oCont.OtherTelephoneNumber = Anti212(oCont.OtherTelephoneNumber) oCont.PrimaryTelephoneNumber = Anti212(oCont.PrimaryTelephoneNumber) oCont.Save Next End Sub Public Sub JournalNote(CorpsNote As String) Dim objApp As Outlook.Application Dim objNote As Outlook.NoteItem Set objApp = New Outlook.Application Set objNote = objApp.CreateItem(ItemType:=olNoteItem) With objNote .Body = CorpsNote .Color = olPink .Save '.Display End With End Sub Function ExtractIndicatif(Num As String) As String ExtractIndicatif = Left(Num, 3) End Function Function Anti212(Num As String) As String Dim Rep As Byte If Mid(Num, 1, 4) = "+212" Then 'Rep = MsgBox("Remplacer " & Num & " par " & "0" & Right(Num, Len(Num) - 4) & " ?", vbQuestion + vbYesNo) 'If Rep = vbYes Then Num = "0" & Right(Num, Len(Num) - 4) 'End If End If Anti212 = Num End Function Function Insere6ou5(Num As String, NomComplet As String) As String If Mid(Num, 2, 1) = "2" Or Mid(Num, 2, 1) = "3" Then ' Est un numéro fixe ou fax ' Exemple : 023655555 devient 0523655555 Insere6ou5 = "05" & Right(Num, 8) ' Debug.Print Compteur & " - " & NomComplet & " : [Fix] " & Num & " devient " & Insere6ou5 JournalMiseAJour = JournalMiseAJour & Compteur & " - " & NomComplet & " : [Fix] " & Num & " > " & Insere6ou5 & vbCrLf End If If Mid(Num, 2, 1) = "1" Or Mid(Num, 2, 1) = "4" Or Mid(Num, 2, 1) = "5" Or Mid(Num, 2, 1) = "6" Or Mid(Num, 2, 1) = "7" Then ' Est un numéro mobile ' Exemple : 047206413 devient 0647206413 Insere6ou5 = "06" & Right(Num, 8) ' Debug.Print Compteur & " - " & NomComplet & " : [Mob] " & Num & " devient " & Insere6ou5 JournalMiseAJour = JournalMiseAJour & Compteur & " - " & NomComplet & " : [Mob] " & Num & " > " & Insere6ou5 & vbCrLf End If If Mid(Num, 2, 1) = "9" And Mid(Num, 3, 1) <> "0" And Mid(Num, 3, 1) <> "2" Then ' Est un numéro mobile ' Exemple : 091505796 devient 0691505796 Insere6ou5 = "06" & Right(Num, 8) ' Debug.Print Compteur & " - " & NomComplet & " : [Mob] " & Num & " devient " & Insere6ou5 JournalMiseAJour = JournalMiseAJour & Compteur & " - " & NomComplet & " : [Mob] " & Num & " > " & Insere6ou5 & vbCrLf End If If Mid(Num, 2, 1) = "8" Then ' Est un numéro fixe non géographique ' Exemple : 081025454 devient 0801025454 Insere6ou5 = "080" & Right(Num, 7) ' Debug.Print Compteur & " - " & NomComplet & " : [FNG] " & Num & " devient " & Insere6ou5 JournalMiseAJour = JournalMiseAJour & Compteur & " - " & NomComplet & " : [FNG] " & Num & " > " & Insere6ou5 & vbCrLf End If If Mid(Num, 2, 1) = "9" And Mid(Num, 3, 1) = "0" And Mid(Num, 3, 1) = "2" Then ' Est un numéro fixe non géographique ' Exemple : 081025454 devient 0801025454 Insere6ou5 = "089" & Right(Num, 7): ' Debug.Print Compteur & " - " & NomComplet & " : [FNG] " & Num & " devient " & Insere6ou5 JournalMiseAJour = JournalMiseAJour & Compteur & " - " & NomComplet & " : [FNG] " & Num & " > " & Insere6ou5 & vbCrLf End If End Function