Import/export automatisé entre outlook et access

Messages postés
6
Date d'inscription
vendredi 27 septembre 2002
Statut
Membre
Dernière intervention
1 mars 2004
-
Messages postés
16
Date d'inscription
lundi 19 avril 2004
Statut
Membre
Dernière intervention
28 juin 2004
-
Bonjour à tous,

J'ai a realiser une procedure qui automatise l'import / export des carnets d'adresses entre outlook2000 et access2000.

On fait intervenir une base intermediaire (ne contenant qu'1 table correspondant au carnet) qui recupere le carnet d'adresse principal de outlook.

De cette base, on transfert les contacts dans une autre base dite base centrale selon deux conditions : il faut qu'ils ne soient pas connus de la base centrale ou qu'ils aient ete modifies.

Puis on recupere la totalité du contenu de la base centrale que l'on reinjecte, apres avoir purge le carnet de contact dans outlook, dans le carnet d'adresse principal.

Cote prog, en utilisant VBA et l'automation, j'ai reussi à exporter les donnees de la base centrale au carnet d'outlook. Je pense que ma procédure de purge fonctionne à peu pres : j'ai des pb de paramètrage car je souhaiterais qu'elle ne se fasse que si la sauvegarde du carnet d'adresse outlook soit faite, c-à-d, si l'export outlook vers access se fait correctement (pour l'instant, étant sur un poste possedant le carnet d'adresse de mon chef, il m'est un peu delicat de le faire....si vous voyez ce que je veux dire, hem). Par contre, ou je coince, c'est le parametrage entre les deux bases intermediaires et centrales. Je vois qu'il y requête SQL sous roche mais comment en realiser la syntaxe vu que les parametres sont nombreux ? De meme, ma procedure dans le sens outlook access buggues mais je ne vois pas pourquoi.
Si qq1 pouvais m'aider, ce serait tres sympa.

Une AP débutante
Raph

Voici tout mon code (je m'excuse pour la longueur mais Microsoft n'est pas mal non plus quant à la longueur de ses noms de proprietes):
__________________________________________
Option Compare Database
Option Explicit
'declaration des constantes
'la variable olkApp fait référence à l'application outlook
Public olkApp As Outlook.Application

'NameSpace sert à faire référence aux données de format MAPI d'Outlook
Public olkNameSpace As Outlook.NameSpace

'-------------------------------------------------------------------------------------
'Realise le 01/10/2002 RBD
'CreateContact
'Cette routine prend les contacts de la table ACCESS 2000pour les reinjecter vers Outlook
' 1° Copier les enregistrement des contacts ACCESS
' 2° Les ajouter aux contacts OUTLOOK 2000
'-------------------------------------------------------------------------------------

Function CreateContact()
End Function

Dim objContactItem As ContactItem ' création de l'objet Contact
Dim snpContacts As DAO.Recordset 'création d'un recordset pour le comptage des contacts à transférer
Dim intCurrRec As Integer ' relatif à la barre de progression
Dim intRecCount As Integer ' relatif à la barre de progression

Application.Echo True, "Veuillez patienter..."
Set snpContacts = CurrentDb.OpenRecordset("Contacts", dbOpenSnapShot)

'Récupération de la valeur du compteur d'enregistrement pour la barre de progression
snpContacts.MoveLast
intRecCount = snpContacts.RecordCount
snpContacts.MoveFirst

'---Initialisation de la barre de progression
SysCmd acSysCmdInitMeter, "Création de contact Outlook...", intRecCount
intCurrRec = 1
'---

Set olkApp = CreateObject("Outlook.Application")
Set olkNameSpace = olkApp.GetNamespace("MAPI")

'Créer une entrée de contact oulook pour chaque enregistrement de contact
Do Until snpContacts.EOF

'---Mise à jour de la barre de progression
SysCmd acSysCmdUpdateMeter, intCurrRec
'---

Set objContactItem = olkApp.CreateItem(olContactItem)
With objContactItem
'la partie de gauche avant = correspond au nom du champ dans Outlook
'la partie après = correspond au nom de champ dans la table ACCESS
' les.? sont les champs dont je n'ai pas trouvé la correspondance
.Title = snpContacts!Titre
.FirstName = snpContacts!Prénom
.MiddleName = snpContacts!DeuxièmePrénom
.LastName = snpContacts!Nom
.Suffix = snpContacts!Suffixe
.CompanyName = snpContacts!Société
.Department = snpContacts!Service
'.? = snpContacts!Titre1
.BusinessAddressStreet = snpContacts!RueBureau
'.? = snpContacts!Ruebureau2
'.? = snpContacts!Ruebureau3
.BusinessAddressCity = snpContacts!VilleBureau
.BusinessAddressState = snpContacts!DépRégionBureau
.BusinessAddressPostalCode = snpContacts!CodePostalBureau
.BusinessAddressCountry = snpContacts!PaysBureau
.HomeAddressStreet = snpContacts!RueDomicile
'.? = snpContacts!Ruedomicile2
'.? = snpContacts!Ruedomicile3
.HomeAddressCity = snpContacts!VilleDomicile
.HomeAddressState = snpContacts!DépRégionDomicile
.HomeAddressPostalCode = snpContacts!CodePostalDomicile
.HomeAddressCountry = snpContacts!PaysDomicile
.OtherAddressStreet = snpContacts!Rueautre
'.? = snpContacts!Rueautre2
'.? = snpContacts!Rueautre3
.OtherAddressCity = snpContacts!Villeautre
.OtherAddressState = snpContacts!DépRégionAutre
.OtherAddressCountry = snpContacts!Paysautre
.AssistantTelephoneNumber = snpContacts!Téléphonedelassistante
.BusinessFaxNumber = snpContacts!Télécopiebureau
.BusinessTelephoneNumber = snpContacts!Téléphonebureau
'.? = snpContacts!Téléphonebureau2 'attention !
.CallbackTelephoneNumber = snpContacts!Rappel
.CarTelephoneNumber = snpContacts!Téléphonevoiture
.CompanyMainTelephoneNumber = snpContacts!TéléphoneSociété
.HomeFaxNumber = snpContacts!Télécopiedomicile
.HomeTelephoneNumber = snpContacts!Téléphonedomicile
.Home2TelephoneNumber = snpContacts!Téléphone2domicile
.ISDNNumber = snpContacts!RNIS
.MobileTelephoneNumber = snpContacts!Télmobile
.OtherFaxNumber = snpContacts!Télécopieautre
.OtherTelephoneNumber = snpContacts!Téléphoneautre
.PagerNumber = snpContacts!Récepteurderadiomessagerie
.PrimaryTelephoneNumber = snpContacts!Téléphoneprincipal
.RadioTelephoneNumber = snpContacts!Radiotéléphone
.TTYTDDTelephoneNumber = snpContacts!TéléphoneTDDTTY
.TelexNumber = snpContacts!Télex
.Email1Address = snpContacts!Adressedemessagerie
'.? = snpContacts!NomcompletdelAdressedemessagerie
.Email2Address = snpContacts!Adressedemessagerie2
'.? = snpContacts!NomcompletdelAdressedemessagerie2
.Email3Address = snpContacts!Adressedemessagerie3
'.? = snpContacts!NomcompletdelAdressedemessagerie3
.Birthday = snpContacts!Anniversaire
'.Anniversary = snpContacts!Anniversairedemariageoufête
.BusinessAddressPostOfficeBox = snpContacts!BP
.OfficeLocation = snpContacts!Bureau
.Categories = snpContacts!Catégories
.GovernmentIDNumber = snpContacts!CodeGouvernement
.CustomerID = snpContacts!Compte
.Spouse = snpContacts!Conjointe
.Sensitivity = snpContacts!Critèredediffusion
'.? = snpContacts!DisponibilitéInternet
'.? = snpContacts!Emplacement
.Children = snpContacts!Enfants
.BillingInformation = snpContacts!Informationsfacturation
.Initials = snpContacts!Initiales
.Mileage = snpContacts!Kilométrage
.Language = snpContacts!Langue
'.? = snpContacts!Motsclé
.AssistantName = snpContacts!Nomdelassistante
'.? = snpContacts!Notes
.OrganizationalIDNumber = snpContacts!Numérodidentificationdelorganisation
.PersonalHomePage = snpContacts!PageWeb
.Hobby = snpContacts!Passetemps
.Importance = snpContacts!Priorité
'.? = snpContacts!Privé
.Profession = snpContacts!Profession
.ReferredBy = snpContacts!Recommandépar
.ManagerName = snpContacts!Responsable
'.? = snpContacts!Serveurdannuaire
.Gender = snpContacts!Sexe
.User1 = snpContacts!Utilisateur1
.User2 = snpContacts!Utilisateur2
.User3 = snpContacts!Utilisateur3
.User4 = snpContacts!Utilisateur4

'Afin de savoir d'où provient le contact (dans ce cas c'est ACCESS)
.Categories = "Contact d'Access"

'on sauvegarde
.Save

End With

snpContacts.MoveNext ' on passe au suivant
intCurrRec = intCurrRec + 1 ' on incrémente d'1
Loop

Set objContactItem = Nothing
Set olkNameSpace = Nothing
Set olkApp = Nothing

'Fait disparaître la barre de progression une fois la manip terminée
SysCmd acSysCmdClearStatus

End Function

'-------------------------------------
'Routine de suppression à parametrer
'---------------------------------------
Sub DeleteContact()

If MsgBox("Attention, vous devez sauvegarder vos contacts d'Outlook avant la mise à jour.", vbOKCancel, "ATTENTION ... SUPPRESSION") = OK Then
'appeler à ce niveau la fonction de rapatriement des contacts outlook vers la base intermédiaire outlook - Public Function NameContactList()

Dim objFolder As Outlook.MAPIFolder
Dim olContactItem As ContactItem

Application.Echo True, "Suppression des contacts Access dans outlook..."

Set olkApp = New Outlook.Application
Set olkNameSpace = olkApp.GetNamespace("MAPI")

Dim IntCurrContact As Integer

Set objFolder = olkNameSpace.GetDefaultFolder(olFolderContacts)

'Commencer la suppression à partir de la fin de la liste
For IntCurrContact = objFolder.Items.Count To Step - 1

'Supprimer l'entrée si elle vient de Access
If objFolder.Items(IntCurrContact).Categories = "Access Contact" Then
objFolder.Items.Remove (IntCurrContact)
End If

Next

Application.Echo True
Else
MsgBox "Suppression non effectuée"

End Sub

Public Function NameContactList()
Set OLContact = OLCreateItem(olContactItem)
With OLContact
.FirstName
End With
End Function

'--------------------
'Routine d'export de outlook vers access
'Function TransfertContact()
'-----------------------

Function TransfertContact()
Dim objContactItem As ContactItem ' création de l'objet Contact
Dim snpContacts As DAO.Recordset 'création d'un recordset pour le comptage des contacts à transférer
Dim intCurrRec As Integer ' relatif à la barre de progression
Dim intRecCount As Integer ' relatif à la barre de progression

Application.Echo True, "Veuillez patienter..."
Set snpContacts = CurrentDb.OpenRecordset("Contacts", dbOpenSnapShot)

'Récupération de la valeur du compteur d'enregistrement pour la barre de progression
snpContacts.MoveLast
intRecCount = snpContacts.RecordCount
snpContacts.MoveFirst

'---Initialisation de la barre de progression
SysCmd acSysCmdInitMeter, "Création de contact Outlook vers BdD...", intRecCount
intCurrRec = 1
'---

Set olkApp = CreateObject("Outlook.Application")
Set olkNameSpace = olkApp.GetNamespace("MAPI")

'Créer une entrée de contact oulook pour chaque enregistrement de contact
Do Until snpContacts.EOF

'---Mise à jour de la barre de progression
SysCmd acSysCmdUpdateMeter, intCurrRec
'---

Set objContactItem = olkApp.CreateItem(olContactItem)
With objContactItem
'la partie de gauche avant = correspond au nom du champ dans Outlook
'la partie après = correspond au nom de champ dans la table ACCESS
snpContacts!Titre = .Title
snpContacts!Prénom = .FirstName
snpContacts!DeuxièmePrénom = .MiddleName
snpContacts!Nom = .LastName
snpContacts!Suffixe = .Suffix
snpContacts!Société = .CompanyName
snpContacts!Service = .Department
'snpContacts!Titre1 = .?
snpContacts!RueBureau = .BusinessAddressStreet
'snpContacts!Ruebureau2 = .?
'snpContacts!Ruebureau3 = .?
snpContacts!VilleBureau = .BusinessAddressCity
snpContacts!DépRégionBureau = .BusinessAddressState
snpContacts!CodePostalBureau = .BusinessAddressPostalCode
snpContacts!PaysBureau = .BusinessAddressCountry
snpContacts!RueDomicile = .HomeAddressStreet
'snpContacts!Ruedomicile2 =.?
' snpContacts!Ruedomicile3 = .?
snpContacts!VilleDomicile = .HomeAddressCity
snpContacts!DépRégionDomicile = .HomeAddressState
snpContacts!CodePostalDomicile = .HomeAddressPostalCode
snpContacts!PaysDomicile = .HomeAddressCountry
snpContacts!Rueautre = .OtherAddressStreet
'snpContacts!Rueautre2 =.?
'snpContacts!Rueautre3 = .?
snpContacts!Villeautre = .OtherAddressCity
snpContacts!DépRégionAutre = .OtherAddressState
snpContacts!Paysautre = .OtherAddressCountry
snpContacts!Téléphonedelassistante = .AssistantTelephoneNumber
snpContacts!Télécopiebureau = .BusinessFaxNumber
snpContacts!Téléphonebureau = .BusinessTelephoneNumber
' snpContacts!Téléphonebureau2
'.Business2TelephoneNumber 'attention !
snpContacts!Rappel = .CallbackTelephoneNumber
snpContacts!Téléphonevoiture = .CarTelephoneNumber
snpContacts!TéléphoneSociété = .CompanyMainTelephoneNumber
snpContacts!Télécopiedomicile = .HomeFaxNumber
snpContacts!Téléphonedomicile = .HomeTelephoneNumber
snpContacts!Téléphone2domicile = .Home2TelephoneNumber
snpContacts!RNIS = .ISDNNumber
snpContacts!Télmobile = .MobileTelephoneNumber
snpContacts!Télécopieautre = .OtherFaxNumber
snpContacts!Téléphoneautre = .OtherTelephoneNumber
snpContacts!Récepteurderadiomessagerie = .PagerNumber
snpContacts!Téléphoneprincipal = .PrimaryTelephoneNumber
snpContacts!Radiotéléphone = .RadioTelephoneNumber
snpContacts!TéléphoneTDDTTY = .TTYTDDTelephoneNumber
snpContacts!Télex = .TelexNumber
snpContacts!Adressedemessagerie = .Email1Address
'snpContacts!NomcompletdelAdressedemessagerie = .?
snpContacts!Adressedemessagerie2 = .Email2Address
'snpContacts!NomcompletdelAdressedemessagerie2 = .?
snpContacts!Adressedemessagerie3 = .Email3Address
'snpContacts!NomcompletdelAdressedemessagerie3 = .?
snpContacts!Anniversaire = .Birthday
snpContacts!Anniversairedemariageoufête = .Anniversary
snpContacts!BP = .BusinessAddressPostOfficeBox
snpContacts!Bureau = .OfficeLocation
snpContacts!Catégories = .Categories
snpContacts!CodeGouvernement = .GovernmentIDNumber
snpContacts!Compte = .CustomerID
snpContacts!Conjointe = .Spouse
snpContacts!Critèredediffusion = .Sensitivity
'snpContacts!DisponibilitéInternet = .?
'snpContacts!Emplacement = .?
snpContacts!Enfants = .Children
snpContacts!Informationsfacturation = .BillingInformation
snpContacts!Initiales = .Initials
snpContacts!Kilométrage = .Mileage
snpContacts!Langue = .Language
'snpContacts!Motsclé = .?
snpContacts!Nomdelassistante = .AssistantName
'snpContacts!Notes = .?
snpContacts! Numérodidentificationdelorganisation .OrganizationalIDNumber
snpContacts!PageWeb = .PersonalHomePage
snpContacts!Passetemps = .Hobby
snpContacts!Priorité = .Importance
'snpContacts!Privé = .?
snpContacts!Profession = .Profession
snpContacts!Recommandé = .ReferredBy
snpContacts!Responsable = .ManagerName
'snpContacts!Serveurdannuaire = .?
snpContacts!Sexe = .Gender
snpContacts!Utilisateur1 = .User1
snpContacts!Utilisateur2 = .User2
snpContacts!Utilisateur3 = .User3
snpContacts!Utilisateur4 = .User4

'on sauvegarde
.Save

End With

snpContacts.MoveNext ' on passe au suivant
intCurrRec = intCurrRec + 1 ' on incrémente d'1
Loop

Set objContactItem = Nothing
Set olkNameSpace = Nothing
Set olkApp = Nothing

'Fait disparaître la barre de progression une fois la manip terminée
SysCmd acSysCmdClearStatus
End Function

3 réponses

Messages postés
1
Date d'inscription
samedi 31 mai 2003
Statut
Membre
Dernière intervention
13 juin 2003

-------------------------------
Réponse au message :
-------------------------------

> Bonjour à tous,
>
> J'ai a realiser une procedure qui automatise l'import / export des carnets d'adresses entre outlook2000 et access2000.
>
> On fait intervenir une base intermediaire (ne contenant qu'1 table correspondant au carnet) qui recupere le carnet d'adresse principal de outlook.
>
> De cette base, on transfert les contacts dans une autre base dite base centrale selon deux conditions : il faut qu'ils ne soient pas connus de la base centrale ou qu'ils aient ete modifies.
>
> Puis on recupere la totalité du contenu de la base centrale que l'on reinjecte, apres avoir purge le carnet de contact dans outlook, dans le carnet d'adresse principal.
>
> Cote prog, en utilisant VBA et l'automation, j'ai reussi à exporter les donnees de la base centrale au carnet d'outlook. Je pense que ma procédure de purge fonctionne à peu pres : j'ai des pb de paramètrage car je souhaiterais qu'elle ne se fasse que si la sauvegarde du carnet d'adresse outlook soit faite, c-à-d, si l'export outlook vers access se fait correctement (pour l'instant, étant sur un poste possedant le carnet d'adresse de mon chef, il m'est un peu delicat de le faire....si vous voyez ce que je veux dire, hem). Par contre, ou je coince, c'est le parametrage entre les deux bases intermediaires et centrales. Je vois qu'il y requête SQL sous roche mais comment en realiser la syntaxe vu que les parametres sont nombreux ? De meme, ma procedure dans le sens outlook access buggues mais je ne vois pas pourquoi.
> Si qq1 pouvais m'aider, ce serait tres sympa.
>
> Une AP débutante
> Raph
>
> Voici tout mon code (je m'excuse pour la longueur mais Microsoft n'est pas mal non plus quant à la longueur de ses noms de proprietes):
> __________________________________________
> Option Compare Database
> Option Explicit
> 'declaration des constantes
> 'la variable olkApp fait référence à l'application outlook
> Public olkApp As Outlook.Application
>
> 'NameSpace sert à faire référence aux données de format MAPI d'Outlook
> Public olkNameSpace As Outlook.NameSpace
>
> '-------------------------------------------------------------------------------------
> 'Realise le 01/10/2002 RBD
> 'CreateContact
> 'Cette routine prend les contacts de la table ACCESS 2000pour les reinjecter vers Outlook
> ' 1° Copier les enregistrement des contacts ACCESS
> ' 2° Les ajouter aux contacts OUTLOOK 2000
> '-------------------------------------------------------------------------------------
>
> Function CreateContact()
> End Function
>
> Dim objContactItem As ContactItem ' création de l'objet Contact
> Dim snpContacts As DAO.Recordset 'création d'un recordset pour le comptage des contacts à transférer
> Dim intCurrRec As Integer ' relatif à la barre de progression
> Dim intRecCount As Integer ' relatif à la barre de progression
>
> Application.Echo True, "Veuillez patienter..."
> Set snpContacts = CurrentDb.OpenRecordset("Contacts", dbOpenSnapShot)
>
> 'Récupération de la valeur du compteur d'enregistrement pour la barre de progression
> snpContacts.MoveLast
> intRecCount = snpContacts.RecordCount
> snpContacts.MoveFirst
>
> '---Initialisation de la barre de progression
> SysCmd acSysCmdInitMeter, "Création de contact Outlook...", intRecCount
> intCurrRec = 1
> '---
>
> Set olkApp = CreateObject("Outlook.Application")
> Set olkNameSpace = olkApp.GetNamespace("MAPI")
>
> 'Créer une entrée de contact oulook pour chaque enregistrement de contact
> Do Until snpContacts.EOF
>
> '---Mise à jour de la barre de progression
> SysCmd acSysCmdUpdateMeter, intCurrRec
> '---
>
> Set objContactItem = olkApp.CreateItem(olContactItem)
> With objContactItem
> 'la partie de gauche avant = correspond au nom du champ dans Outlook
> 'la partie après = correspond au nom de champ dans la table ACCESS
> ' les.? sont les champs dont je n'ai pas trouvé la correspondance
> .Title = snpContacts!Titre
> .FirstName = snpContacts!Prénom
> .MiddleName = snpContacts!DeuxièmePrénom
> .LastName = snpContacts!Nom
> .Suffix = snpContacts!Suffixe
> .CompanyName = snpContacts!Société
> .Department = snpContacts!Service
> '.? = snpContacts!Titre1
> .BusinessAddressStreet = snpContacts!RueBureau
> '.? = snpContacts!Ruebureau2
> '.? = snpContacts!Ruebureau3
> .BusinessAddressCity = snpContacts!VilleBureau
> .BusinessAddressState = snpContacts!DépRégionBureau
> .BusinessAddressPostalCode = snpContacts!CodePostalBureau
> .BusinessAddressCountry = snpContacts!PaysBureau
> .HomeAddressStreet = snpContacts!RueDomicile
> '.? = snpContacts!Ruedomicile2
> '.? = snpContacts!Ruedomicile3
> .HomeAddressCity = snpContacts!VilleDomicile
> .HomeAddressState = snpContacts!DépRégionDomicile
> .HomeAddressPostalCode = snpContacts!CodePostalDomicile
> .HomeAddressCountry = snpContacts!PaysDomicile
> .OtherAddressStreet = snpContacts!Rueautre
> '.? = snpContacts!Rueautre2
> '.? = snpContacts!Rueautre3
> .OtherAddressCity = snpContacts!Villeautre
> .OtherAddressState = snpContacts!DépRégionAutre
> .OtherAddressCountry = snpContacts!Paysautre
> .AssistantTelephoneNumber = snpContacts!Téléphonedelassistante
> .BusinessFaxNumber = snpContacts!Télécopiebureau
> .BusinessTelephoneNumber = snpContacts!Téléphonebureau
> '.? = snpContacts!Téléphonebureau2 'attention !
> .CallbackTelephoneNumber = snpContacts!Rappel
> .CarTelephoneNumber = snpContacts!Téléphonevoiture
> .CompanyMainTelephoneNumber = snpContacts!TéléphoneSociété
> .HomeFaxNumber = snpContacts!Télécopiedomicile
> .HomeTelephoneNumber = snpContacts!Téléphonedomicile
> .Home2TelephoneNumber = snpContacts!Téléphone2domicile
> .ISDNNumber = snpContacts!RNIS
> .MobileTelephoneNumber = snpContacts!Télmobile
> .OtherFaxNumber = snpContacts!Télécopieautre
> .OtherTelephoneNumber = snpContacts!Téléphoneautre
> .PagerNumber = snpContacts!Récepteurderadiomessagerie
> .PrimaryTelephoneNumber = snpContacts!Téléphoneprincipal
> .RadioTelephoneNumber = snpContacts!Radiotéléphone
> .TTYTDDTelephoneNumber = snpContacts!TéléphoneTDDTTY
> .TelexNumber = snpContacts!Télex
> .Email1Address = snpContacts!Adressedemessagerie
> '.? = snpContacts!NomcompletdelAdressedemessagerie
> .Email2Address = snpContacts!Adressedemessagerie2
> '.? = snpContacts!NomcompletdelAdressedemessagerie2
> .Email3Address = snpContacts!Adressedemessagerie3
> '.? = snpContacts!NomcompletdelAdressedemessagerie3
> .Birthday = snpContacts!Anniversaire
> '.Anniversary = snpContacts!Anniversairedemariageoufête
> .BusinessAddressPostOfficeBox = snpContacts!BP
> .OfficeLocation = snpContacts!Bureau
> .Categories = snpContacts!Catégories
> .GovernmentIDNumber = snpContacts!CodeGouvernement
> .CustomerID = snpContacts!Compte
> .Spouse = snpContacts!Conjointe
> .Sensitivity = snpContacts!Critèredediffusion
> '.? = snpContacts!DisponibilitéInternet
> '.? = snpContacts!Emplacement
> .Children = snpContacts!Enfants
> .BillingInformation = snpContacts!Informationsfacturation
> .Initials = snpContacts!Initiales
> .Mileage = snpContacts!Kilométrage
> .Language = snpContacts!Langue
> '.? = snpContacts!Motsclé
> .AssistantName = snpContacts!Nomdelassistante
> '.? = snpContacts!Notes
> .OrganizationalIDNumber = snpContacts!Numérodidentificationdelorganisation
> .PersonalHomePage = snpContacts!PageWeb
> .Hobby = snpContacts!Passetemps
> .Importance = snpContacts!Priorité
> '.? = snpContacts!Privé
> .Profession = snpContacts!Profession
> .ReferredBy = snpContacts!Recommandépar
> .ManagerName = snpContacts!Responsable
> '.? = snpContacts!Serveurdannuaire
> .Gender = snpContacts!Sexe
> .User1 = snpContacts!Utilisateur1
> .User2 = snpContacts!Utilisateur2
> .User3 = snpContacts!Utilisateur3
> .User4 = snpContacts!Utilisateur4
>
> 'Afin de savoir d'où provient le contact (dans ce cas c'est ACCESS)
> .Categories = "Contact d'Access"
>
> 'on sauvegarde
> .Save
>
> End With
>
> snpContacts.MoveNext ' on passe au suivant
> intCurrRec = intCurrRec + 1 ' on incrémente d'1
> Loop
>
> Set objContactItem = Nothing
> Set olkNameSpace = Nothing
> Set olkApp = Nothing
>
>
> 'Fait disparaître la barre de progression une fois la manip terminée
> SysCmd acSysCmdClearStatus
>
> End Function
>
> '-------------------------------------
> 'Routine de suppression à parametrer
> '---------------------------------------
> Sub DeleteContact()
>
> If MsgBox("Attention, vous devez sauvegarder vos contacts d'Outlook avant la mise à jour.", vbOKCancel, "ATTENTION ... SUPPRESSION") = OK Then
> 'appeler à ce niveau la fonction de rapatriement des contacts outlook vers la base intermédiaire outlook - Public Function NameContactList()
>
> Dim objFolder As Outlook.MAPIFolder
> Dim olContactItem As ContactItem
>
> Application.Echo True, "Suppression des contacts Access dans outlook..."
>
> Set olkApp = New Outlook.Application
> Set olkNameSpace = olkApp.GetNamespace("MAPI")
>
> Dim IntCurrContact As Integer
>
> Set objFolder = olkNameSpace.GetDefaultFolder(olFolderContacts)
>
> 'Commencer la suppression à partir de la fin de la liste
> For IntCurrContact = objFolder.Items.Count To Step - 1
>
> 'Supprimer l'entrée si elle vient de Access
> If objFolder.Items(IntCurrContact).Categories = "Access Contact" Then
> objFolder.Items.Remove (IntCurrContact)
> End If
>
> Next
>
> Application.Echo True
> Else
> MsgBox "Suppression non effectuée"
>
> End Sub
>
> Public Function NameContactList()
> Set OLContact = OLCreateItem(olContactItem)
> With OLContact
> .FirstName
> End With
> End Function
>
> '--------------------
> 'Routine d'export de outlook vers access
> 'Function TransfertContact()
> '-----------------------
>
> Function TransfertContact()
> Dim objContactItem As ContactItem ' création de l'objet Contact
> Dim snpContacts As DAO.Recordset 'création d'un recordset pour le comptage des contacts à transférer
> Dim intCurrRec As Integer ' relatif à la barre de progression
> Dim intRecCount As Integer ' relatif à la barre de progression
>
> Application.Echo True, "Veuillez patienter..."
> Set snpContacts = CurrentDb.OpenRecordset("Contacts", dbOpenSnapShot)
>
> 'Récupération de la valeur du compteur d'enregistrement pour la barre de progression
> snpContacts.MoveLast
> intRecCount = snpContacts.RecordCount
> snpContacts.MoveFirst
>
> '---Initialisation de la barre de progression
> SysCmd acSysCmdInitMeter, "Création de contact Outlook vers BdD...", intRecCount
> intCurrRec = 1
> '---
>
> Set olkApp = CreateObject("Outlook.Application")
> Set olkNameSpace = olkApp.GetNamespace("MAPI")
>
> 'Créer une entrée de contact oulook pour chaque enregistrement de contact
> Do Until snpContacts.EOF
>
> '---Mise à jour de la barre de progression
> SysCmd acSysCmdUpdateMeter, intCurrRec
> '---
>
> Set objContactItem = olkApp.CreateItem(olContactItem)
> With objContactItem
> 'la partie de gauche avant = correspond au nom du champ dans Outlook
> 'la partie après = correspond au nom de champ dans la table ACCESS
> snpContacts!Titre = .Title
> snpContacts!Prénom = .FirstName
> snpContacts!DeuxièmePrénom = .MiddleName
> snpContacts!Nom = .LastName
> snpContacts!Suffixe = .Suffix
> snpContacts!Société = .CompanyName
> snpContacts!Service = .Department
> 'snpContacts!Titre1 = .?
> snpContacts!RueBureau = .BusinessAddressStreet
> 'snpContacts!Ruebureau2 = .?
> 'snpContacts!Ruebureau3 = .?
> snpContacts!VilleBureau = .BusinessAddressCity
> snpContacts!DépRégionBureau = .BusinessAddressState
> snpContacts!CodePostalBureau = .BusinessAddressPostalCode
> snpContacts!PaysBureau = .BusinessAddressCountry
> snpContacts!RueDomicile = .HomeAddressStreet
> 'snpContacts!Ruedomicile2 =.?
> ' snpContacts!Ruedomicile3 = .?
> snpContacts!VilleDomicile = .HomeAddressCity
> snpContacts!DépRégionDomicile = .HomeAddressState
> snpContacts!CodePostalDomicile = .HomeAddressPostalCode
> snpContacts!PaysDomicile = .HomeAddressCountry
> snpContacts!Rueautre = .OtherAddressStreet
> 'snpContacts!Rueautre2 =.?
> 'snpContacts!Rueautre3 = .?
> snpContacts!Villeautre = .OtherAddressCity
> snpContacts!DépRégionAutre = .OtherAddressState
> snpContacts!Paysautre = .OtherAddressCountry
> snpContacts!Téléphonedelassistante = .AssistantTelephoneNumber
> snpContacts!Télécopiebureau = .BusinessFaxNumber
> snpContacts!Téléphonebureau = .BusinessTelephoneNumber
> ' snpContacts!Téléphonebureau2
> '.Business2TelephoneNumber 'attention !
> snpContacts!Rappel = .CallbackTelephoneNumber
> snpContacts!Téléphonevoiture = .CarTelephoneNumber
> snpContacts!TéléphoneSociété = .CompanyMainTelephoneNumber
> snpContacts!Télécopiedomicile = .HomeFaxNumber
> snpContacts!Téléphonedomicile = .HomeTelephoneNumber
> snpContacts!Téléphone2domicile = .Home2TelephoneNumber
> snpContacts!RNIS = .ISDNNumber
> snpContacts!Télmobile = .MobileTelephoneNumber
> snpContacts!Télécopieautre = .OtherFaxNumber
> snpContacts!Téléphoneautre = .OtherTelephoneNumber
> snpContacts!Récepteurderadiomessagerie = .PagerNumber
> snpContacts!Téléphoneprincipal = .PrimaryTelephoneNumber
> snpContacts!Radiotéléphone = .RadioTelephoneNumber
> snpContacts!TéléphoneTDDTTY = .TTYTDDTelephoneNumber
> snpContacts!Télex = .TelexNumber
> snpContacts!Adressedemessagerie = .Email1Address
> 'snpContacts!NomcompletdelAdressedemessagerie = .?
> snpContacts!Adressedemessagerie2 = .Email2Address
> 'snpContacts!NomcompletdelAdressedemessagerie2 = .?
> snpContacts!Adressedemessagerie3 = .Email3Address
> 'snpContacts!NomcompletdelAdressedemessagerie3 = .?
> snpContacts!Anniversaire = .Birthday
> snpContacts!Anniversairedemariageoufête = .Anniversary
> snpContacts!BP = .BusinessAddressPostOfficeBox
> snpContacts!Bureau = .OfficeLocation
> snpContacts!Catégories = .Categories
> snpContacts!CodeGouvernement = .GovernmentIDNumber
> snpContacts!Compte = .CustomerID
> snpContacts!Conjointe = .Spouse
> snpContacts!Critèredediffusion = .Sensitivity
> 'snpContacts!DisponibilitéInternet = .?
> 'snpContacts!Emplacement = .?
> snpContacts!Enfants = .Children
> snpContacts!Informationsfacturation = .BillingInformation
> snpContacts!Initiales = .Initials
> snpContacts!Kilométrage = .Mileage
> snpContacts!Langue = .Language
> 'snpContacts!Motsclé = .?
> snpContacts!Nomdelassistante = .AssistantName
> 'snpContacts!Notes = .?
> snpContacts! Numérodidentificationdelorganisation .OrganizationalIDNumber
> snpContacts!PageWeb = .PersonalHomePage
> snpContacts!Passetemps = .Hobby
> snpContacts!Priorité = .Importance
> 'snpContacts!Privé = .?
> snpContacts!Profession = .Profession
> snpContacts!Recommandé = .ReferredBy
> snpContacts!Responsable = .ManagerName
> 'snpContacts!Serveurdannuaire = .?
> snpContacts!Sexe = .Gender
> snpContacts!Utilisateur1 = .User1
> snpContacts!Utilisateur2 = .User2
> snpContacts!Utilisateur3 = .User3
> snpContacts!Utilisateur4 = .User4
>
> 'on sauvegarde
> .Save
>
> End With
>
> snpContacts.MoveNext ' on passe au suivant
> intCurrRec = intCurrRec + 1 ' on incrémente d'1
> Loop
>
> Set objContactItem = Nothing
> Set olkNameSpace = Nothing
> Set olkApp = Nothing
>
>
> 'Fait disparaître la barre de progression une fois la manip terminée
> SysCmd acSysCmdClearStatus
> End Function
>
Messages postés
1
Date d'inscription
dimanche 26 octobre 2003
Statut
Membre
Dernière intervention
26 octobre 2003

bonjour je suis un debutant pourriez vous m'envoyer ce code source pour synchronisez outlook et access merci d'avance
Messages postés
16
Date d'inscription
lundi 19 avril 2004
Statut
Membre
Dernière intervention
28 juin 2004

Salut !
Dans le cadre de mon stage de fin d'étude, je dois automatiser la création de contacts et des listes de diffusion, à partir d'une base Access.
Seulement, la création des contacts prend 45 min, et la création des listes encore plus !
Quelqu'un aurait une idée.

PS : j'ai essayer d'optimiser mon code à fond, mais j'ai l'impression que Outlook prend du temps en passant par le serveur Exchange.

Zlackzj