Discussion :

[pbatty1]

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:

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

Si quelqu'un a une idée de ce qui permet d'affecter les informations dans "mes contacts".
Je vous remercie à l'avance

pbatty

[Oliv-]

Salut,
Après avoir créé ton dossier tu dois y positionner le dossier en cours :

Code :

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

1
2
 Set objOutlook.ActiveExplorer.CurrentFolder = _
objFolder.folders("contact sipromad")

Avec ton code à chaque fois tu vas essayer de creer ce nouveau dossier tu peux mettre soit condition sur la recherche de l'existance de ce dossier soit tu mais un

Code :

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

on error resume next

avant et un

Code :

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

on error goto 0

après le

Set objStrCtc= objFolder.Folders.Add(StrSipro)

[pbatty1]

Merci, ça marche. j'ai mis un test sur l'existance du dossier avant de le créer.

Code :

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

1
2
3
4
5
  StrSipro = "contact sipromad"
  If (objFolder.Folders.Count > 0) Then
 
  objFolder.Folders.Remove 1
  End If