Synchronisation du dossier publics "contacts entreprise" avec les contacts personnel dans Outlook 2000
Source / Exemple :
Attribute VB_Name = "Module11"
Sub ajout_contacts()
Dim oOL As Outlook.Application
Dim oNS As Outlook.NameSpace
Dim oRestricted As Outlook.Items
Dim oFolder As Outlook.MAPIFolder
Dim oItems As Outlook.Items
Dim oContact As Outlook.ContactItem
Dim nombre As Integer
Dim citem
Dim oemployee As Outlook.ContactItem
Set oOL = New Outlook.Application
Set oemployeefolder = oOL.GetNamespace("MAPI").Folders("Dossiers publics")
Set oemployeefolder = oemployeefolder.Folders("Tous les dossiers publics")
Set oemployeefolder = oemployeefolder.Folders("contacts entreprise")
nombre = 0
Set oOL = GetObject(, "Outlook.Application")
If oOL Is Nothing Then
Set oOL = CreateObject("Outlook.Application")
End If
Set oNS = oOL.GetNamespace("MAPI")
Set oContact = oOL.CreateItem(olContactItem)
Set oFolder = oNS.GetDefaultFolder(olFolderContacts)
For Each citem In oemployeefolder.Items
If comparer(citem.FileAs) = False Then
Set oOL = GetObject(, "Outlook.Application")
If oOL Is Nothing Then
Set oOL = CreateObject("Outlook.Application")
End If
Set oNS = oOL.GetNamespace("MAPI")
Set oContact = oOL.CreateItem(olContactItem)
Set oFolder = oNS.GetDefaultFolder(olFolderContacts)
Set oItems = oFolder.Items
'For Each objcontactitem.ContactItem.olContactItem In oContact
With oContact
'.FullName = citem.FullName
'.HomeAddress = "AdresseSamples"
.Account = citem.Account
.Anniversary = citem.Anniversary
.AssistantName = citem.AssistantName
.AssistantTelephoneNumber = citem.AssistantTelephoneNumber
.BillingInformation = citem.BillingInformation
.Birthday = citem.Birthday
.Body = citem.Body
.BusinessTelephoneNumber = citem.BusinessTelephoneNumber
.BusinessFaxNumber = citem.BusinessFaxNumber
.Business2TelephoneNumber = citem.Business2TelephoneNumber
.BusinessAddressPostOfficeBox = citem.BusinessAddressPostOfficeBox
.BusinessAddressState = citem.BusinessAddressState
.BusinessAddressStreet = citem.BusinessAddressStreet
.BusinessHomePage = citem.BusinessHomePage
.CallbackTelephoneNumber = citem.CallbackTelephoneNumber
.CarTelephoneNumber = citem.CarTelephoneNumber
.Categories = citem.Categories
.Children = citem.Children
.Companies = citem.Companies
.CompanyName = citem.CompanyName
.ComputerNetworkName = citem.ComputerNetworkName
.CustomerID = citem.CustomerID
.Department = citem.Department
.Email1Address = citem.Email1Address
.Email1AddressType = citem.Email1AddressType
.Email2Address = citem.Email2Address
.Email2AddressType = citem.Email2AddressType
.Email3Address = citem.Email3Address
.Email3AddressType = citem.Email3AddressType
.FileAs = citem.FileAs
.FirstName = citem.FirstName
.FormDescription = citem.FormDescription
.FTPSite = citem.FTPSite
.FullName = citem.FullName
.Gender = citem.Gender
.GetInspector = citem.GetInspector
.GovernmentIDNumber = citem.GovernmentIDNumber
.Hobby = citem.Hobby
.Home2TelephoneNumber = citem.Home2TelephoneNumber
.HomeAddress = citem.HomeAddress
.HomeAddressCity = citem.HomeAddressCity
.HomeAddressCountry = citem.HomeAddressCountry
.HomeAddressPostalCode = citem.HomeAddressPostalCode
.HomeAddressPostOfficeBox = citem.HomeAddressPostOfficeBox
.HomeAddressState = citem.HomeAddressState
.HomeAddressStreet = citem.HomeAddressStreet
.HomeFaxNumber = citem.HomeFaxNumber
.HomeTelephoneNumber = citem.HomeTelephoneNumber
.Importance = citem.Importance
.Initials = citem.Initials
.InternetFreeBusyAddress = citem.InternetFreeBusyAddress
.ISDNNumber = citem.ISDNNumber
.JobTitle = citem.JobTitle
.Journal = citem.Journal
.Language = citem.Language
.LastName = citem.LastName
.MailingAddress = citem.MailingAddress
.MailingAddressCity = citem.MailingAddressCity
.MailingAddressCountry = citem.MailingAddressCountry
.MailingAddressPostalCode = citem.MailingAddressPostalCode
.MailingAddressPostOfficeBox = citem.MailingAddressPostOfficeBox
.MailingAddressState = citem.MailingAddressState
.MailingAddressStreet = citem.MailingAddressStreet
.ManagerName = citem.ManagerName
.MessageClass = citem.MessageClass
.MiddleName = citem.MiddleName
.Mileage = citem.Mileage
.MobileTelephoneNumber = citem.MobileTelephoneNumber
.NetMeetingAlias = citem.NetMeetingAlias
.NetMeetingServer = citem.NetMeetingServer
.NickName = citem.NickName
.NoAging = citem.NoAging
.OfficeLocation = citem.OfficeLocation
.OrganizationalIDNumber = citem.OrganizationalIDNumber
.OtherAddress = citem.OtherAddress
.OtherAddressCity = citem.OtherAddressCity
.OtherAddressCountry = citem.OtherAddressCountry
.OtherAddressPostalCode = citem.OtherAddressPostalCode
.OtherAddressPostOfficeBox = citem.OtherAddressPostOfficeBox
.OtherAddressState = citem.OtherAddressState
.OtherAddressStreet = citem.OtherAddressStreet
.OtherFaxNumber = citem.OtherFaxNumber
.OtherTelephoneNumber = citem.OtherTelephoneNumber
.PagerNumber = citem.PagerNumber
.PersonalHomePage = citem.PersonalHomePage
.PrimaryTelephoneNumber = citem.PrimaryTelephoneNumber
.Profession = citem.Profession
.RadioTelephoneNumber = citem.RadioTelephoneNumber
.ReferredBy = citem.ReferredBy
.SelectedMailingAddress = citem.SelectedMailingAddress
.Sensitivity = citem.Sensitivity
.Spouse = citem.Spouse
.Subject = citem.Subject
.Suffix = citem.Suffix
.TelexNumber = citem.TelexNumber
.Title = citem.Title
.TTYTDDTelephoneNumber = citem.TTYTDDTelephoneNumber
.UnRead = citem.UnRead
.User1 = citem.User1
.User2 = citem.User2
.User3 = citem.User3
.User4 = citem.User4
.UserCertificate = citem.UserCertificate
.WebPage = citem.WebPage
.YomiCompanyName = citem.YomiCompanyName
.YomiFirstName = citem.YomiFirstName
.YomiLastName = citem.YomiLastName
oContact.Save
Set oContact = Nothing
Set oFolder = Nothing
Set oItems = Nothing
nombre = nombre + 1
End With
End If
Next
afic = MsgBox("Ajout de " & nombre & " contacts", vbCritical, "Contacts manager")
End Sub
Function comparer(nomcomplet)
Dim str1Input
Dim str2Input
Dim ditem
Dim strOutput
str1Input = nomcomplet
'str2Input = prenomcomplet
Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNameSpace.GetDefaultFolder(olFolderContacts)
For Each ditem In objFolder.Items
If (ditem.FileAs = str1Input) Then
'If (ditem.LastName = str2Input) Then
comparer = True
Exit Function
End If
'End If
Next
If strOutput = "" Then
comparer = False
End If
End Function
Conclusion :
la syncronisation des carnet d'adresse chez microsoft est un casse tete, il est possible de forcer outlook express, ainssi que le telecopieur a utiliser le carnet d'adresse de outlook 2000, mais pas les carnet d'adresse de l'entreprise d'ou le devellopement de cette macro.
(HKCU/software/Microsoft/Wab/WAB4/UseOutlook = 1)
Code directement interpreté sous forme de macro sous outlook.
Ouvert à toutes améliorations.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.