modification GetDefaultFolder d'une liste des contacts crée [Résolu]

[jumpers70]

Bonjour,j'ai le code suivant qui fait l'importation des contacts à travers une base de donnée Access,quand je l’exécute la modification se fait dans la liste des contacts par défaut (contacts),j'ai crée un liste que j'ai appelé (base partagée), comment je peut modifier le code pour qu'il fait la modification sur la liste que j'ai crée.

Code :

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
Public Sub MettreAJourContactS()
On Error Resume Next
Dim oCont As ContactItem
Dim oCo As ContactItem
Dim oFold As Folder
Dim nM As NameSpace
Dim olApp As Outlook.Application
Dim stFilt As String
Dim rs As DAO.Recordset
Dim db As DAO.Database
 
 
Set db = OpenDatabase("X:\contacts.mdb")
Set rs = db.OpenRecordset("Select * From Contacts")
Set olApp = Outlook.Application
Set nM = olApp.GetNamespace("MAPI")
Set oFold = nM.GetDefaultFolder(olFolderdb)
nM.G
       ' MsgBox rs.Fields("messagerie")
 
While Not rs.EOF
stFilt = "[FirstName] = """ & rs.Fields("[Prénom]")
'stFilt = "[Email1Address] = """ & rs.Fields("messagerie")
stFilt = stFilt & """ And [LastName] = """ & rs.Fields("Nom") & """"
 
Set oCo = oFold.Items.Find(stFilt)
'oCo.Display
'oCont.Display
'If Not oCo Is Nothing Then
     Set oCont = oFold.Items.Add
       'oCont.Delete
    '   oCont.Display
      oCont.FirstName = rs.Fields("Prénom")
      oCont.LastName = rs.Fields("Nom")
      oCont.Email1Address = rs.Fields("Adresse de messagerie")
      oCont.BusinessTelephoneNumber = rs.Fields("code")
      oCont.MobileTelephoneNumber = rs.Fields("telem")
      oCont.HomeTelephoneNumber = rs.Fields("telep")
      oCont.JobTitle = rs.Fields("fonction")
      oCont.CompanyName = rs.Fields("societe")
 
      oCont.Save
      oCo.Delete
oCo = Nothing
'End If
'oCont.Delete
'oCo.Delete
rs.MoveNext
Wend
'rs.Delete
 
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub

Merci,