import/export automatisé entre outlook et access

Question

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

stef13009 · Answer

-------------------------------
 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
>

thierry-joel · Answer

bonjour je suis un debutant pourriez vous m'envoyer ce code source pour synchronisez outlook et access merci d'avance

zlackzj13 · Answer

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

Import/export automatisé entre outlook et access

3 réponses

Discussions similaires