Contact Outlook

Signaler
Messages postés
2
Date d'inscription
vendredi 16 avril 2004
Statut
Membre
Dernière intervention
26 décembre 2006
-
Messages postés
2
Date d'inscription
vendredi 16 avril 2004
Statut
Membre
Dernière intervention
26 décembre 2006
-
Bonjour,

J'ai actuellement un petit en vb qui rechercher dans mon carnet d'adresse les contacts en  [mailto:nomcontact@masociete.com nomcontact@masociete.com] et les renomme en [mailto:nomcontact@masociete2.com nomcontact@masociete2.com]

Je dois le modifier pour les cas ou pour le même contact, on a deux contacts différentes exemple (un perso et un entreprise)
:
Nom complet TOTO et les adresses liées à cette personne est [mailto:toto@masociete.com toto@masociete.com] et [mailto:toto2@masociete2.com toto2@masociete2.com] , en fait le vb doit modifier les deux adresses en [mailto:toto@masociete3.com toto@masociete3.com] et
[mailto:toto2@masociete3.com toto2@masociete3.com]

Voici les sources:

1 réponse

Messages postés
2
Date d'inscription
vendredi 16 avril 2004
Statut
Membre
Dernière intervention
26 décembre 2006

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)




Private Sub Command1_Click()
Unload frmmodification
End Sub


'Phase de mise à jour des contacts
Private Sub Form_Activate()
  


    Dim objficlog, email1
    Dim j As Integer
   
    Set myOlApp = CreateObject("Outlook.Application")
    Set mynamespace = myOlApp.GetNamespace("MAPI")
   
    Set objfolder = mynamespace.GetDefaultFolder(olFolderContacts)
    v_folder = objfolder.EntryID


    Set objContacts = mynamespace.GetFolderFromID(v_folder)
    Set objallcontacts = objContacts.Items
   
    frmmodification.ProgressBar1.Max = objallcontacts.Count
    j = 1


    frmmodification.Label4.Caption = j
    frmmodification.Label6.Caption = objallcontacts.Count
    Sleep 200
    Me.Refresh
   
    'Declaration du fichier de Logues
    Set objfic = CreateObject("Scripting.FileSystemObject")
    Set objficlog = objfic.OpenTextFile("c:\logs\verifcontactLight.log", 2, True)
    objficlog.Write Date & "  " & Time & vbCrLf


    On Error Resume Next
   
    For Each contact In objallcontacts
       
        frmmodification.Label4.Caption = j
        frmmodification.ProgressBar1.Value = 1 + frmmodification.ProgressBar1.Value
       
        If contact.IsConflict = False Then
           
            If Err.Number <> 0 Then
                objficlog.Write "ERROR => " & Err.Description & vbCrLf
                Err.Clear
            End If
           
            Me.Refresh
           
            If TypeName(contact) = "ContactItem" Then
                objficlog.Write "VERIFICATION DU CONTACT N° " & frmmodification.ProgressBar1.Value & "" & vbCrLf
                objficlog.Write contact.Email1Address & " " & contact.Email2Address & " " & contact.Email3Address & vbCrLf
                k = 1
                email1 = contact.Email1Address
           
                'Problème des adresses masociete.com restants dans l'aperçu du dossier contact
                contact.Email1Address = ""
                contact.Save
                contact.Email1Address = email1
                contact.Save
                  'And contact.Email1Address <> "EX"
                If contact.Email1Address <> "" Then
                    contact.Email1Address = Replace(contact.Email1Address, "[mailto:nomcontact@masociete.com nomcontact@masociete.com]", "[mailto:nomcontact@masociete2.com nomcontact@masociete2.com]")
                    contact.Email1DisplayName = ""
                    contact.Save
                End If
                   
            End If
       
        End If
       
        j = j + 1
        Sleep 20
   
    Next




    Set objnamespace = Nothing
    Set objallcontacts = Nothing
    Set objContacts = Nothing
    Unload frmmodification
    frmok.Show


End Sub