Code pour Filtrage mails Outlook

**clickandgo** · 05/05/2013, 13h00

Bonjour à tous,

Je désire importer les mails Outlook dans une table Access par rapport à un filtre des adresses mails de clients contenus dans une table "clients", il faut donc créer une requête mais je ne sais pas ou l'inclure dans le code joint.

D'autre part je voudrais qu'au lieu que soit présenté le treeview des dossiers Outlook ne soient visibles que les comptes courriers et que la fonction recherche automatiquement dans les sous-dossiers tous les mails en appliquant le filtre par mails clients.

Merci d'avance pour vos suggestions

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
69
70
71
72
73
Public Function ImportMailsOutlook()
On Error Resume Next
 
Dim strAttachment As String
Dim strSQL As String
Dim rsMail As DAO.Recordset
Dim tdf As DAO.TableDef
 
Dim Ol_App As New Outlook.Application
Dim Ol_MAPI As Outlook.Namespace
Dim Ol_Folder As Outlook.MAPIFolder
Dim Ol_Items As Outlook.MailItem
Dim Ol_Attach As Outlook.Attachment
 
Set tdf = CurrentDb.TableDefs("TblMails")
Set rsMail = CurrentDb.OpenRecordset("TblMails")
Set Ol_MAPI = Ol_App.GetNamespace("MAPI")
Set Ol_Folder = Ol_MAPI.PickFolder
 
For Each Ol_Items In Ol_Folder.Items
 
For Each Ol_Attach In Ol_Items.Attachments
 
    strAttachment = strAttachment & Ol_Attach.DisplayName & vbCrLf
 
Next Ol_Attach
 
 
 
With rsMail
 
    .AddNew
 
    .Fields("BCC") = Ol_Items.BCC
    .Fields("Categories") = Ol_Items.Categories
    .Fields("CC") = Ol_Items.CC
    .Fields("ConversationTopic") = Ol_Items.ConversationTopic
    .Fields("CreationTime") = Ol_Items.CreationTime
    .Fields("HTMLBody") = Ol_Items.HTMLBody
    .Fields("LastModificationTime") = Ol_Items.LastModificationTime
    .Fields("ReceivedByName") = Ol_Items.ReceivedByName
    .Fields("ReceivedOnBehalfOfName") = Ol_Items.ReceivedOnBehalfOfName
    .Fields("ReceivedTime") = Ol_Items.ReceivedTime
    .Fields("SenderName") = Ol_Items.SenderName
    .Fields("Sent") = Ol_Items.Sent
    .Fields("SentOn") = Ol_Items.SentOn
    .Fields("SenderAddress") = Ol_Items.Reply.Recipients.Item(1).Address
    .Fields("Size") = Ol_Items.Size
    .Fields("Subject") = Ol_Items.Subject
    .Fields("TO") = Ol_Items.TO
    .Fields("UnRead") = Ol_Items.UnRead
    .Fields("Attachments") = strAttachment
    .Update
 
End With
 
strAttachment = ""
 
Next Ol_Items
 
rsMail.Close
MsgBox "Les données ont été importées"
 
Set rsMail = Nothing
Set tdf = Nothing
 
Set Ol_Attach = Nothing
Set Ol_Items = Nothing
Set Ol_Folder = Nothing
Set Ol_MAPI = Nothing
Set Ol_App = Nothing
 
End Function

**mumen** · 06/05/2013, 12h40

Bonjour

Je désire importer les mails Outlook dans une table Access par rapport à un filtre des adresses mails de clients contenus dans une table "clients", il faut donc créer une requête mais je ne sais pas ou l'inclure dans le code joint.

A ce stade, ce n'est pas une requête qu'il te faut, c'est un index sur ta table Client.

Maintenant, tu peux aussi choisir de faire une requête suppression après importation. Tu fais une requête sur les mails, avec un lien sur les clients par le mail, et tu supprimes tous les mails qui n'ont pas ce lien.

D'autre part je voudrais qu'au lieu que soit présenté le treeview des dossiers Outlook ne soient visibles que les comptes courriers et que la fonction recherche automatiquement dans les sous-dossiers tous les mails en appliquant le filtre par mails clients.

Alors là, désolé, je ne comprend pas ce que tu dis.

**clickandgo** · 06/05/2013, 14h48

Bonjour,

Je me suis peut être mal expliqué :

Je cherche à implanter un filtre avant importation qui interrogerait les champs qui contiennent uniquement les adresses mails clients de la table "clients".

Chaque client peut avoir jusqu'à 3 adresses différentes ...

Cela pour éviter d'importer tout le contenu des dossiers, et sans avoir à passer par un tri préalable dans Outlook.

**mumen** · 06/05/2013, 15h26

Bon, disons que dans ton code tu as un champ strMail que tu assignera à ce qui doit être (From, To).

Dans la solution que je te montre ici, soit tu as peu de clients, soit tu as le temps.

Avant la boucle, tu places ceci :

Code :

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

1
2
3
4
5
    Dim db as database
    Dim strSQL as string
    Dim strMail as string
    Dim blnMailTrouvé as boolean
    Set db= CurrentDb

Dans la boucle :

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
    For Each Ol_Items In Ol_Folder.Items
        strMail = Ol_Items.FROM
        strSQL = "SELECT IdClient FROM Client" _
            & " WHERE Mail1 = " & strMail _
            & " OR Mail2 = " & strMail _
            & " OR Mail3 = " & strMail 
 
        With db.OpenRecordset( strSQL)
            blnMailTrouvé = (.EOF = False)
        End With
 
        If blnMailTrouvé Then
            With rsMail 
                .AddNew 
                .Fields("BCC") = Ol_Items.BCC
 
                etc.
            End With
        End If
    Next

**clickandgo** · 06/05/2013, 23h51

Merci beaucoup pour tout ce travail mais j'ai un dernier problème : il me dit "Next sans For" à la ligne 73 or je ne vois pas pourquoi : (j'ai dû me tromper dans l'ordre de certaines lignes)

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Public Function ImportMailsOutlook()
On Error Resume Next
 
Dim db As Database
Dim strAttachment As String
Dim strSQL As String
Dim rsMail As DAO.Recordset
Dim tdf As DAO.TableDef
Dim blnMailTrouvé As Boolean
Dim strMail As String
 
Dim Ol_App As New Outlook.Application
Dim Ol_MAPI As Outlook.NameSpace
Dim Ol_Folder As Outlook.MAPIFolder
Dim Ol_Items As Outlook.MailItem
Dim Ol_Attach As Outlook.Attachment
 
Set tdf = CurrentDb.TableDefs("TblMails")
Set rsMail = CurrentDb.OpenRecordset("TblMails")
Set Ol_MAPI = Ol_App.GetNamespace("MAPI")
Set Ol_Folder = Ol_MAPI.PickFolder
Set db = CurrentDb
 
For Each Ol_Items In Ol_Folder.Items
 
strMail = Ol_Items.From
        strSQL = "SELECT NumClient FROM Clients" _
            & " WHERE Mail1 = " & strMail _
            & " OR Mail2 = " & strMail _
            & " OR Mail3 = " & strMail
 
        With db.OpenRecordset(strSQL)
            blnMailTrouvé = (.EOF = False)
        End With
        For Each Ol_Attach In Ol_Items.Attachments
 
    strAttachment = strAttachment & Ol_Attach.DisplayName & vbCrLf
 
Next Ol_Attach
 
 
        If blnMailTrouvé Then
 
With rsMail
 
    .AddNew
 
    .Fields("BCC") = Ol_Items.BCC
    .Fields("Categories") = Ol_Items.Categories
    .Fields("CC") = Ol_Items.CC
    .Fields("ConversationTopic") = Ol_Items.ConversationTopic
    .Fields("CreationTime") = Ol_Items.CreationTime
    .Fields("HTMLBody") = Ol_Items.HTMLBody
    .Fields("LastModificationTime") = Ol_Items.LastModificationTime
    .Fields("ReceivedByName") = Ol_Items.ReceivedByName
    .Fields("ReceivedOnBehalfOfName") = Ol_Items.ReceivedOnBehalfOfName
    .Fields("ReceivedTime") = Ol_Items.ReceivedTime
    .Fields("SenderName") = Ol_Items.SenderName
    .Fields("Sent") = Ol_Items.Sent
    .Fields("SentOn") = Ol_Items.SentOn
    .Fields("SenderAddress") = Ol_Items.Reply.Recipients.item(1).Address
    .Fields("Size") = Ol_Items.Size
    .Fields("Subject") = Ol_Items.Subject
    .Fields("TO") = Ol_Items.To
    .Fields("UnRead") = Ol_Items.UnRead
    .Fields("Attachments") = strAttachment
    .Update
 
End With
 
strAttachment = ""
 
Next Ol_Items
rsMail.Close
MsgBox "Les données ont été importées"
Forms![Mails]![sf mails importés outlook].Form.Requery
 
 
 
Set rsMail = Nothing
Set tdf = Nothing
 
Set Ol_Attach = Nothing
Set Ol_Items = Nothing
Set Ol_Folder = Nothing
Set Ol_MAPI = Nothing
Set Ol_App = Nothing
 
End Function

Merci de ton aide

**mumen** · 07/05/2013, 00h18

Tu devrais apprendre à indenter correctement ton code.

Ligne 70 mettre end if

**clickandgo** · 07/05/2013, 01h15

Merci, on avance ...

Le code ne pose plus de problème mais par contre il ne retourne aucun résultat, peu importe le dossier Outlook ...

Cela aurait il un rapport avec le fait que les champs mail1 , mail2 , mail3 de la table clients sont en format hyperlink et qu'il faudrait extraire l'adresse avant ?
Si oui comment faire ?

(Je viens d'essayer en remettant les champs mails au format texte simple et en effacant les préfixes mailto, mais ça ne change rien, j'entends le disque dur mouliner mais rien ne vient comme résultat..., j'ai aussi essayé de mettre Ol_Items.sender ou sendermailadress à la place de "from", aucun résultat)

**mumen** · 07/05/2013, 12h25

Utilise l'outil que tu as. Apprend à déboguer. A employer la fenêtre de débogage.

Fais F9 sur une ligne, ça arête le code sur cette ligne, place ta souris sur une variable, tu verras ce qu'elle contient. Fais F8, le code avance d'une ligne, F5 il repart, etc.

**clickandgo** · 07/05/2013, 15h06

Bonjour et merci,

Je viens donc de suivre ton conseil, la requête renvoie un résultat correct pour le filtre on dirait mais par contre aucune donnée n'est créée dans la table, serait-ce une erreur de boucle ?

Je ne suis pas assez à l'aise pour le déterminer ...

D'autre part BlnMailTrouvé renvoie "faux" est-ce normal ?

**mumen** · 07/05/2013, 16h24

Ce n'est pas blnMailTrouvé qu'il faut regarder, c'est strMail, qui doit contenir un mail recherché dans le client, exactement comme il est entré dans le client. Si dedans il y a "toto<toto@xyz.fr>" alors que tu as entré "toto@xyz.fr" dans le client, ça ne trouvera rien.

**clickandgo** · 07/05/2013, 19h11

Alors comme dit plus haut, la requête fonctionne et renvoie bien une adresse complète venant de la base client, cependant, aucune donnée n'est importée dans la table ...

En passant la souris je vois que cette ligne pose problème :

Code :

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

blnMailTrouvé = (.EOF = False)

on me dit : "variable de bloc ou variable objet With non définie"

Ca doit pas être grand chose ...

Il devrait être possible de faire un count() aussi sur le résultat de la boucle pour plus de confort, je vais essayer voir si j'arrive à ce que les lignes soient comptées.

**mumen** · 07/05/2013, 23h28

Ok, remplace ton code par celui ci, et suis les explications que j'ai écrites en remarque. Tu verras que j'ai indenté le code, c'est à dire géré les espaces pour qu'il représentent clairement les blocs logiques par des décalages de quatre espaces.

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
Option Compare Database
Option Explicit
 
Public Function ImportMailsOutlook()
    On Error Resume Next
 
    Dim db As Database
    Dim strAttachment As String
    Dim strSQL As String
    Dim rsMail As DAO.Recordset
    Dim blnMailTrouvé As Boolean
    Dim strMail As String
 
    Dim Ol_App As New Outlook.Application
    Dim Ol_MAPI As Outlook.NameSpace
    Dim Ol_Folder As Outlook.MAPIFolder
    Dim Ol_Items As Outlook.MailItem
    Dim Ol_Attach As Outlook.Attachment
 
    Set rsMail = CurrentDb.OpenRecordset("TblMails")
    Set Ol_MAPI = Ol_App.GetNamespace("MAPI")
    Set Ol_Folder = Ol_MAPI.PickFolder
    Set db = CurrentDb
 
    For Each Ol_Items In Ol_Folder.Items
 
        strMail = Ol_Items.From
        '
        Debug.Print strMail
        '
        ' Ici regarde après une exécution dans la fenêtre de debogage (Ctrl +G)
        ' si le mail contenu dans strMail est formatté comme dans ta
        ' table client. Quand tu auras fini tout ça, n'oublie pas
        ' d'enlever la ligne avec debug.print.
 
        strSQL = "SELECT NumClient FROM Clients" _
            & " WHERE Mail1 = " & strMail _
            & " OR Mail2 = " & strMail _
            & " OR Mail3 = " & strMail
        ' Cette requête SQL cherche le mail dans les trois champs de
        ' la table client
        '
        ' Ici, dans un deuxième temps enléve la mise en remarque de la
        ' ligne qui suit :
        'Debug.Print strSQL: Stop
        ' vas dans la fenêtre de débogage et copie colle la phrase SQL
        ' dans une requête pour comprendre ce qui se passe.
        '
        With db.OpenRecordset(strSQL)
            blnMailTrouvé = (.EOF = False)
            ' Si EOF (fin de fichier) = Vrai, alors il n'y a pas
            ' d'enregistrement trouvé : l'équation Vrai = Faux (False) donne
            ' Faux : le mail n'est pas trouvé dans l'un des trois champs
            ' de la la table client donc on ne l'ajoute pas. C'est ce que
            ' tu as demandé.
        End With
 
        If blnMailTrouvé Then
            strAttachment = ""
            For Each Ol_Attach In Ol_Items.Attachments
                strAttachment = strAttachment & Ol_Attach.DisplayName & vbCrLf
            Next Ol_Attach
            With rsMail
               .AddNew
               !BCC = Ol_Items.BCC
               !Categories = Ol_Items.Categories
               !CC = Ol_Items.CC
               !ConversationTopic = Ol_Items.ConversationTopic
               !CreationTime = Ol_Items.CreationTime
               !HTMLBody = Ol_Items.HTMLBody
               !LastModificationTime = Ol_Items.LastModificationTime
               !ReceivedByName = Ol_Items.ReceivedByName
               !ReceivedOnBehalfOfName = Ol_Items.ReceivedOnBehalfOfName
               !ReceivedTime = Ol_Items.ReceivedTime
               !SenderName = Ol_Items.SenderName
               !Sent = Ol_Items.Sent
               !SentOn = Ol_Items.SentOn
               !SenderAddress = Ol_Items.Reply.Recipients.Item(1).Address
               !Size = Ol_Items.Size
               !Subject = Ol_Items.Subject
               !To = Ol_Items.To
               !UnRead = Ol_Items.UnRead
               !Attachments = strAttachment
               .Update
            End With
        End If
    Next Ol_Items
    rsMail.Close
    MsgBox "Les données ont été importées"
    Forms![Mails]![sf mails importés outlook].Form.Requery
    Set rsMail = Nothing
    Set Ol_Attach = Nothing
    Set Ol_Items = Nothing
    Set Ol_Folder = Nothing
    Set Ol_MAPI = Nothing
    Set Ol_App = Nothing
End Function

**clickandgo** · 08/05/2013, 01h07

Je te remercie pour ton dévouement et pédagogie, malheureusement rien ne s'enregistre dans la table malgré que les adresses mails sont bien passées dans la variable strMail.

D'aute part serait il possible de renvoyer le compte de mails trouvés ?

J'ai essayé avec Dcount mais je suppose que celui-ci ignore la boucle donc il faut peut être arriver à compter les instances plutôt que les lignes du résultat de requête ? comment fait on ?

**Thierry_PALLIER** · 09/05/2013, 10h43

Bonjour clickandgo et mumen.
Ce code déclenche peut-être la sécurité Outlook ?!

Office 2003

This topic has not yet been rated - Rate this topic

Returns a String indicating the display name of the sender for the e-mail message, meeting item, or post. This property corresponds to the MAPI property PR_SENDER_NAME. Read-only.

property.

expression.SenderName

Remarks

Outlook blocks code that attempts to access the SenderName property for security reasons. If you run a third-party add-in, custom solution, or other program that uses the SenderName property in Office Outlook 2003, you may receive the following warning:

A program is trying to automatically send e-mail on your behalf. Do you want to allow this? If this is unexpected, it may be a virus and you should choose "No".
voir

msdn
D'autre part,est-ce utile de stocker tout çà dans une table ?
tu pourrais stocker simplement son identifiant (myNameSpace.GetItemFromID)et facilement l'ouvrir en cas de besoin.
Cdlt

**clickandgo** · 09/05/2013, 12h38

Bonjour Thierry,

Je ne pense pas que ça vienne de là vu que je suis sous Access 2010 et que la première version du code remplissait bien la table mais sans le filtre sur les adresses mail.

D'autre part je désire importer dans une table car sait on jamais, le fichier PST pourrait s'endommager, mais ceci dit je n'ai pas très bien compris ta suggestion ...

**mumen** · 09/05/2013, 13h29

Je te remercie pour ton dévouement et pédagogie, malheureusement rien ne s'enregistre dans la table malgré que les adresses mails sont bien passées dans la variable strMail.

Tu ne répond pas à la question. As tu lu les remarques dans le code ?

**clickandgo** · 09/05/2013, 15h28

Bonjour,

Le code s'éxécute sans aucun warning et la variable strMail reprend bien la liste des mails clients dans la fenêtre d' éxécution ...

Je ne vois pas ce qu'il faut investiguer, je suis débutant

**mumen** · 09/05/2013, 15h58

Le code s'éxécute sans aucun warning et la variable strMail reprend bien la liste des mails clients dans la fenêtre d' éxécution ...

Premier point :
L'ensemble des mails inscrits dans la fenêtre d'exécution est il formatté comme dans tes clients ?

Deuxième point, enlève le

Code :

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

on error resume next

Que va-t'il se passer ? ça va planter sur

Code :

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

With db.OpenRecordset(strSQL)

Pourquoi ?

parce que tu n'as rien changé à

Code :

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

1
2
3
4
strSQL = "SELECT NumClient FROM Clients" _
            & " WHERE Mail1 = " & strMail _
            & " OR Mail2 = " & strMail _
            & " OR Mail3 = " & strMail

Comment se nomme ta table client ?
Comment se nomment les 3 champs mail de ta table client ?

En plus j'ai laissé un bug ici :

Code :

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

1
2
3
4
strSQL = "SELECT NumClient FROM Clients" _
            & " WHERE Mail1 = """ & strMail & """" _
            & " OR Mail2 = """ & strMail & """"  _
            & " OR Mail3 = """ & strMail & """"

**clickandgo** · 09/05/2013, 17h35

Il y a du progrès !

Ca marche mais il indique en pointant la ligne "next Ol_item" une incompatibilité de type ...
Cependant les données sont correctement importées.

Il manque donc juste à traiter l'incompatibilité et d'ajouter un compteur sur le Msgbox si faisable facilement.

**mumen** · 09/05/2013, 17h48

montre le code

Code pour Filtrage mails Outlook

VBA Access

Discussions similaires

Partager

Partager