Contact Outlook
snakiki
Messages postés
2
Date d'inscription
vendredi 16 avril 2004
Statut
Membre
Dernière intervention
26 décembre 2006
-
26 déc. 2006 à 17:19
snakiki Messages postés 2 Date d'inscription vendredi 16 avril 2004 Statut Membre Dernière intervention 26 décembre 2006 - 26 déc. 2006 à 17:21
snakiki Messages postés 2 Date d'inscription vendredi 16 avril 2004 Statut Membre Dernière intervention 26 décembre 2006 - 26 déc. 2006 à 17:21
A voir également:
- Contact Outlook
- Accueil nouveautés "inscrire un site" contact admin ✓ - Forum C# / .NET
- Accueil nouveautés inscrire un site contact admin - Forum PHP
- Comment automatiser l'ouverture d'un lien sur un site web ? - Forum VB.NET
- Activer macro outlook - Forum Visual Basic
- Comment activer les macro dans outlook - Forum Visual Basic
1 réponse
snakiki
Messages postés
2
Date d'inscription
vendredi 16 avril 2004
Statut
Membre
Dernière intervention
26 décembre 2006
26 déc. 2006 à 17:21
26 déc. 2006 à 17:21
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
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
