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

**reptedoz** · 02/05/2008, 15h21

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** · 03/05/2008, 11h01

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 :

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
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** · 04/05/2008, 19h25

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** · 05/05/2008, 11h12

Bonjour,

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
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** · 06/05/2008, 22h35

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** · 07/05/2008, 11h22

Bonjour,

La je ne vois pas ???

**Dolphy35** · 07/05/2008, 23h02

Salut,

il n'y a un un s à olFolderContacts

Code :

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

Set ContactFolder = myNameSpace.GetDefaultFolder(olFolderContacts)

Dolphy

**reptedoz** · 08/05/2008, 17h30

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** · 08/05/2008, 20h17

Salut,

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

Code :

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

MsgBox JournalItems.Count

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

Dolphy

**reptedoz** · 09/05/2008, 17h39

salut toi !

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

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
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** · 09/05/2008, 18h32

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

Merci !

**Dolphy35** · 11/05/2008, 19h14

Salut,

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

Code :

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

MsgBox JournalItems.Count

Dolphy

**reptedoz** · 13/05/2008, 11h05

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 :

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

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** · 13/05/2008, 11h15

Salut,

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

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
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** · 14/05/2008, 20h09

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** · 14/05/2008, 20h48

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** · 14/05/2008, 21h17

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

**reptedoz** · 14/05/2008, 21h19

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** · 20/05/2008, 13h49

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-** · 20/05/2008, 17h26

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

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
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

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

VBA Outlook

Discussions similaires

Partager

Partager