bonjour,
Je viens de créer une liste de contact sur outlook via une base de données. Les adresses sont effectivement enregistrées dans contacts. Pourtant, j'ai créé un dossier "mes contacts" qui doit acceuillir la liste. Je ne trouve pas le moyen de spécifier le dossier cible.
Je vous présente ci-dessous mon code:
Si quelqu'un a une idée de ce qui permet d'affecter les informations dans "mes contacts".
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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68 Private Sub MAJ() 'Connect to Ms Outlook Dim objOutlook As Outlook.Application Dim objFolder As Outlook.MAPIFolder Dim objNamespace As Outlook.NameSpace Dim objAllContacts As Outlook.Items Dim Contact As Outlook.ContactItem Dim objStrCtc As MAPIFolder Dim StrCtc As String Dim newContact As Object Dim prenom As String Dim nom As String Dim mail As String Set objOutlook = CreateObject("Outlook.Application") Set objNamespace = objOutlook.GetNamespace("MAPI") Set objFolder = objNamespace.GetDefaultFolder(olFolderContacts) 'connect to MySQL server using MySQL ODBC 3.51 Driver Dim conn As ADODB.Connection Dim rs As ADODB.Recordset Dim fld As ADODB.Field Dim sql As String Set conn = New ADODB.Connection conn.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" _ & "SERVER=localhost;" _ & "DATABASE=gestion_email;" _ & "UID=root; OPTION=3" 'ici mot de passe vide PWD 'open Database conn.Open Set rs = New ADODB.Recordset rs.Open "SELECT Nom,Prenom,Adresse_mail FROM adresse", conn Debug.Print rs.RecordCount If Not (rs.BOF = True And rs.EOF = True) Then 'Cette requete a un résultat 'Création dossier StrCtc = "contact sipromad" Set objStrCtc= objFolder.Folders.Add(StrSipro) rs.MoveFirst Do Until rs.EOF = True Set newContact = objOutlook.CreateItem(olContactItem) newContact.FullName = rs.Fields("PreNom").Value newContact.LastName = rs.Fields("Nom").Value newContact.Email1Address = rs.Fields("Adresse_mail").Value newContact.Save rs.MoveNext Loop Else Debug.Print "Aucun enregistrement" End If End Sub
Je vous remercie à l'avance
pbatty
Partager