Discussion :

[Franzouille]

Bonjour à tous,
je cherche un moyen de faire une liaison entre des contacts Outlook et une base de donnée Access avec des tables sociétés, Personnes, Fournisseurs. J'ai 2 questions : est-il possible de créer une procédure stockée permettant de modifier les champs de ces tables ainsi que les champs dans les contacts Outlook ? Sachant que cela doit se faire sur le terminal server de mon entreprise où Office 2016 est installé
Et enfin : peut-on facilement importer/partager des données d'Outlook 2016 sur Access 2016 ( je ne trouve pas grande chose la dessus )...

Pour le moment, tout cela est encore théorique, je suis étudiant en informatique et je dois préparer cela pour mon stage...
Merci d'avance pour vos lumières !

[Crevette54]

Bonsoir,

oui tu peux lié les contacts Outlook sous Access sans problème, voici une fonction qui cherche un contact :

PS : ces fonctions servent de test pour le moment et tu as besoin de cocher la référence Microsoft Outlook xx.0 Object Library.

Tu peux regarder la : http://outlook.developpez.com/faq/?page=VBA et là : http://www.developpez.net/forums/d15...geant-version/

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Function ContactsExiste(Nom_, Prenom_, Telephone_, Mail_, Adresse_ As String) As Integer
 
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Dim myContacts As Outlook.Items
'Dim myItems As Outlook.Items*
Dim Cible As Outlook.ContactItem
Dim ol_OK As Integer
 
Set myolApp = CreateObject("Outlook.Application")
'Vérifie si Outlook est ouvert !!!!!!
If myolApp.Explorers.Count > 0 Then
   'Debug.Print "Outlook est ouvert"
Else
   'Debug.Print "Outlook n'est pas ouvert"
   ol_OK = Shell("C:\Program Files (x86)\Microsoft Office\root\Office16\OUTLOOK.EXE", 3)
End If
 
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Items
 
For Each Cible In myContacts
   'Debug.Print Cible.FirstName, Cible.LastName, Cible.User1, Cible.MobileTelephoneNumber, Cible.Email1Address, Cible.HomeAddress, Cible.Categories
   If (Cible.LastName = Nom_) And (Cible.FirstName = Prenom_) And (Cible.MobileTelephoneNumber = Telephone_) And (Cible.Email1Address = Mail_) And (Cible.HomeAddress = Adresse_) Then
      'Debug.Print Cible.FirstName, Cible.LastName, Cible.User1, Cible.MobileTelephoneNumber, Cible.Email1Address, Cible.HomeAddress, Cible.Categories
      ContactsExiste = 2
      Exit For
   Else
 
      If (Cible.LastName = Nom_) And (Cible.FirstName = Prenom_) Then
         ContactsExiste = 1
         'Debug.Print Cible.FirstName, Cible.LastName, Cible.User1, Cible.MobileTelephoneNumber, Cible.Email1Address, Cible.HomeAddress, Cible.Categories
         Exit For
      Else
         ContactsExiste = 0
 
      End If
   End If
   DoEvents
Next
 
Set myContacts = Nothing
Set myNamespace = Nothing
Set myolApp = Nothing
 
End Function

Une autre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Function EmailExisteDansContact(Email As String) As Boolean
 
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Dim myContacts As Outlook.Items
Dim myItems As Outlook.Items
Dim myItem As Object
Dim strWhere As String
 
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Items
 
strWhere = "[Email1Address] ='" & Email & "' or [Email2Address] ='" & Email & "' or [Email3Address] ='" & Email & "'"
Set myItems = myContacts.Restrict(strWhere)
If myItems.Count > 0 Then
   EmailExisteDansContact = True
Else
   EmailExisteDansContact = False
End If
 
End Function

Pour créer un contact dans outlook :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
'--------------------------------------------------------
'Fonction de création d'un contact
'Les données sont passé en une seul chaine de caractères :
'Nom;Prenom;Telephone;Mail;Adresse;User1;Categories
'--------------------------------------------------------
 
Sub ContactsCreate(Nom_, Prenom_, Telephone_, Mail_, Adresse_, User1_, Categorie_ As String)
 
'Dim myoApp As Outlook.Application
Dim myolApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Dim myContacts As Outlook.Items
Dim oContact As Outlook.ContactItem
 
Set myolApp = CreateObject("Outlook.Application")
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Items
 
Set oContact = myolApp.CreateItem(olContactItem)
 
oContact.LastName = Nom_
oContact.FirstName = Prenom_
oContact.MobileTelephoneNumber = Telephone_
oContact.Email1Address = Mail_
oContact.HomeAddress = Adresse_
oContact.User1 = User1_
oContact.Categories = Categorie_
oContact.Save
 
 
Set myContacts = Nothing
Set myNamespace = Nothing
Set myolApp = Nothing
 
End Sub

J'espère avoir répondu à une partie de ta question.

Bon courage.

[Franzouille]

Bonjour Crevette54, merci beaucoup pour cette réponse, c'est exactement ce que je cherchais !
Je vais tester tout ça très bientôt, j'écrirais un message si il y a d'autres informations à savoir sur le sujet.

Encore merci !

Franzouille