macro pour associer une liste d'entrées journals aux contacts ayant la même société [Résolu]

[reptedoz]

bonjour,

je vous explique mon problème :

je viens d'importer une liste de plus de 1000 contacts dans outlook 2003 ainsi que plus de 3000 entrées journals, tous cela depuis une base de données access. Je souhait donc utiliser ma liste de contact outlook comme nouvel base de données avec un suivi des activités par contact.

Mon problème est que je n'arrive pas a lier les entrées journal aux contacts avec l'importation. Il n'y a aucune possibilité avec outlook de définir à quel contact il faut associer l'élément lors de son importation. Je cherche une solution plus rapide que de prendre les contact un par un pour leur associer les éléments journal correspondant. Pour l'instant le seul lien qu'il existe entre les fiches contacts avec les fiches entrées journal, c'est qu'ils ont le même nom de société.

Je me demandais donc s'il n'y avait pas possibilité, par l'intermédiaire d'un macro, d'associer les entrées journal aux contacts qui ont le même nom de société. Ou alors un macro qui permettrait remplir le champs "contacts" par la valeur du champs "société" a partir d'une liste d'entrées journal.

Si quelqu'un a une idée, je suis preneur !

Merci d'avance de l'intérêt que vous porté a ma question.

bonne journée a vous

[Laurent CUENET]

Bonjour,

ce code fonctionne si tu as seulement
- des fiches contacts dans ton dossier contact et pas de liste de distribution.
- avec les dossiers par défaut de contact et de journal

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
Sub lien()
 
Set myNameSpace = Application.GetNamespace("MAPI")
Set JournalFolder = myNameSpace.GetDefaultFolder(olFolderJournal)
Set ContactFolder = myNameSpace.GetDefaultFolder(olFolderContact)
 
Set JournalItems = JournalFolder.items
Set ContactItems = ContactFolder.items
 
JournalItems.SetColumns ("Companies")
ContactItems.SetColumns ("Subject, CompanyName") 
 
For Each Jitm in JournalItems
 
Filtre = "[CompanyName]<>'" & Jitm.Companies & "'"
Set ritms = ContactItems.Restrict(Filtre)
For Each Citm In ritms
 
Jitm.Contact = Citm.subject
Jitm.Save
 
Next
Next
 
End Sub

Si tu as un problème avec le setcolumns tu peux la remplacer avec la méthode restrict.

A bientôt,

[reptedoz]

bonjour,

merci beaucoup d'avoir pris le soin de répondre a ma question, cela veux dejà dir que ce n'est pas impossible...
Je viens d'essayer mais il m'indique qu'une ou plusieurs valeurs de paramètre ne sont pas valides (erreur 440) . Je ne m'y connais pas beaucoup en prog macro, vois-tu d'où ces erreurs pourraient venir ?

En tout cas merci encore de ton attention !

a biento

[Laurent CUENET]

Bonjour,

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub lien()
 
Set myNameSpace = Application.GetNamespace("MAPI")
Set JournalFolder = myNameSpace.GetDefaultFolder(olFolderJournal)
Set ContactFolder = myNameSpace.GetDefaultFolder(olFolderContact)
 
Set JournalItems = JournalFolder.items
Set ContactItems = ContactFolder.items
 
For Each Jitm in JournalItems
 
Filtre = "[CompanyName]<>'" & Jitm.Companies & "'"
Set ritms = ContactItems.Restrict(Filtre)
For Each Citm In ritms
 
Jitm.Contact = Citm.subject
Jitm.Save
 
Next
Next
 
End Sub

Si tu as des numéro de ligne merci de les indiquer

A bientôt,

[reptedoz]

bonjour Laurent,

Merci pour ta réponse rapide !
Je viens d'essayer ton nouveau code mais lorsqu'il arrive sur les lignes
"Set JournalItems = JournalFolder.Items
Set ContactItems = ContactFolder.Items"
il fait un message d'erreur signalant des valeur non valide.

Voila la seul info que je peux te donner.

Merci pour ton aide ! a bientôt

[Laurent CUENET]

Bonjour,

La je ne vois pas ???

[Dolphy35]

Salut,

il n'y a un un s à olFolderContacts

Code :

Set ContactFolder = myNameSpace.GetDefaultFolder(olFolderContacts)

Dolphy

[reptedoz]

merci pour ton aide, ca a passé l'erreur !

par contre maintenant lorsqu'il arrive sur For "Each Jitm In JournalItems"

il me signale une erreur 424, Objet requis. Je ne sais pas quoi faire.

Merci encore de votre aide

a bientot

[Dolphy35]

Salut,

place cette ligne avant le For Each et donne nous le résultat :

Code :

MsgBox JournalItems.Count

si c'est égal à zéro c'est que que tu n'a pas d'item dans ton dossier.


Dolphy

[reptedoz]

salut toi !

alors je viens d'essayer cela, j'ai le code suivant :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub lien()
 
Set myNameSpace = Application.GetNamespace("MAPI")
Set JournalFolder = myNameSpace.GetDefaultFolder(olFolderJournal)
Set ContactFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
 
Set JournalItems = JournalFolder.Items
Set ContactItems = ContactsFolder.Items
 
MsgBox JournalItems.Count
For Each Jitm In JournalItems
 
Filtre = "[CompanyName]<>'" & Jitm.Companies & "'"
Set ritms = ContactItems.Restrict(Filtre)
For Each Citm In ritms
 
Jitm.Contact = Citm.Subject
Jitm.Save
 
Next
Next
 
End Sub

Mai il me fait toujours la même erreur....

Merci encore a vous tous !

a biento

[reptedoz]

PS : Si je n'ai pas d'item dans mon dossier, comment faire pour en créer un ?

Merci !

[Dolphy35]

Salut,


ton erreur est toujours au même endroit ou elle s'est déplacée sur cette ligne ?

Code :

MsgBox JournalItems.Count

Dolphy

[reptedoz]

Salut,

Et bien lorsqu'il n'y avais pas ta ligne de code, il me faisait l'erreur lorsqu'il arrivait sur la ligne

Code :

For Each Jitm In JournalItems

, maintenant en insérant ta ligne, comme je l'ai montré plus haut, il me fait la même erreur 424 (objet requis) en arrivant sur cette nouvelle ligne.

voila !

Encore merci à vous !

[Dolphy35]

Salut,

il y avait un petit s en trop dans tes instances :
Le code suivant fonctionne très bien chez moi

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
Sub lien()
 
    Set myNameSpace = Application.GetNamespace("MAPI")
    Set JournalFolder = myNameSpace.GetDefaultFolder(olFolderJournal)
    Set ContactFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
 
    Set JournalItems = JournalFolder.items
    Set ContactItems = ContactFolder.items
 
    MsgBox JournalItems.Count
 
    For Each Jitm In JournalItems
 
        Filtre = "[CompanyName]<>'" & Jitm.Companies & "'"
        Set ritms = ContactItems.Restrict(Filtre)
        For Each Citm In ritms
 
            Jitm.Contact = Citm.Subject
            Jitm.Save
 
        Next
    Next
 
End Sub

[reptedoz]

salut tout le monde !

merci Dolphy pour ton aide... ça a réglé mon problème, j'y suis presque ! maintenant il ne bloque plus que sur la dernière ligne "Jitm.Save" où il me fait l'erreur 438 (propriété ou methode non gérée par l'objet).
Comment cela ce fait si ça marche chez toi mais pas chez moi ?

Merci a tous

[Dolphy35]

Salut,

je n'ai pas testé après la boucle For Each.

Enlève la ligne Jitm.Save.
pour tester.

dès que j'aurais un moment je testerais le code entier

Dolphy

[reptedoz]

enfaite je crois crois que c'est à la ligne "Jitm.Contact = Citm.Subject
" qu'il bug. je ne sais pas trop

[reptedoz]

je viens d'essayer d'enlever cette ligne "jitm.save" et il me fait la même erreur après avoir passé la ligne "Jitm.Contact = Citm.Subject" qu'il me fait l'erreur.

Merci encore a toi !

[reptedoz]

salut Dolphy35, je voulais savoir s'il était possible d'avoir une solution asses rapidement, je suis bloqué pour mon travaille à cause de cela.
Sens vouloir t'agresser non plus, tu en fais déjà beaucoup pour moi, j'en ai conscience et je t'en remercie encore énormément. Fais ce que tu peux.

Merci

à bientôt

[Oliv-]

Bonjour,
il me semble qu'il y a quelques une erreurs :

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
Sub lien()
 
    Set myNameSpace = Application.GetNamespace("MAPI")
    Set JournalFolder = myNameSpace.GetDefaultFolder(olFolderJournal)
    Set ContactFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
    Dim JournalItems, ContactItems
    Set JournalItems = JournalFolder.Items
    Set ContactItems = ContactFolder.Items
 
    MsgBox JournalItems.Count
    Dim Jitm As JournalItem
    For Each Jitm In JournalItems
'ici    
        Filtre = "[CompanyName]='" & Jitm.Companies & "'"
        Dim ritms As Object
        Set ritms = ContactItems.Restrict(Filtre)
        Dim citm As ContactItem
        For Each citm In ritms
        MsgBox citm
'ici
            Jitm.ContactNames = citm.Subject
            Jitm.Save
 
        Next
    Next
 
End Sub

Avec ce code cela veut dire que l'entrée du journal est associée au dernier CONTACT trouvé pour une même compagnie.! c'est bien ce que tu veux ?

Tu peux ajouter un
on error resume next
Au début pour passer les erreurs