Discussion :

[jean.cdc]

Bonjour,

Je souhaite rechercher des mails dans ma boite aux lettres à partir d'Excel en utilisant la fonction AdvancedSearch.

Vu sur le site de MSDN, le code fourni est le 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
Public blnSearchComp As Boolean
 
Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)
    MsgBox "The AdvancedSearchComplete Event fired."
    blnSearchComp = True
End SubSub
 
TestAdvancedSearchComplete()
    Dim sch As Outlook.Search
    Dim rsts As Outlook.Results
    Dim i As Integer
    blnSearchComp = False
    Const strF As String = "urn:schemas:mailheader:subject = 'Test'"
    Const strS As String = "Inbox"
    Set sch = Application.AdvancedSearch(strS, strF)
    While blnSearchComp = False
        DoEvents
    Wend
    Set rsts = sch.Results
    For i = 1 To rsts.Count
        MsgBox rsts.Item(i).SenderName
    Next
End Sub

Pour l'utiliser sous Excel, j'ai adapter le code comme ci_dessous :

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
Public blnSearchComp As Boolean
 
Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)
    MsgBox "The AdvancedSearchComplete Event fired"
    blnSearchComp = True
End Sub
 
Sub TestAdvancedSearchComplete()
 
    Dim olApp As Outlook.Application
    Dim olNameSpace As Outlook.Namespace
    Dim olDossier As Outlook.MAPIFolder
    Dim sch As Outlook.Search
    Dim rsts As Outlook.Results
    Dim i As Integer
 
    blnSearchComp = False
 
    Const strF As String = "urn:schemas:mailheader:subject = 'test'"
    Const strS As String = "Inbox"
 
    Set olApp = CreateObject("Outlook.Application")
 
    Set sch = olApp.AdvancedSearch(strS, strF)
 
    While blnSearchComp = False
        DoEvents
    Wend
 
    Set rsts = sch.Results
 
    For i = 1 To rsts.Count
        MsgBox rsts.Item(i).SenderName
    Next
 
End Sub

Si cet essai fonctionne correctement sous Outlook, ce n'est pas le cas sous Excel. J'obtiens bien le message "The AdvancedSearchComplete Event fired" mais ensuite le programme tourne sans arrêt.

Quelqu'un peut-il m'aider ?

Merci d'avance.

[Theze]

Bonjour Jean,

Je ne suis pas compétant dans l'utilisation d'Outlook en VBA mais de ce que je pige, la proc "Application_AdvancedSearchComplete" doit être lancée automatiquement sitôt qu'une recherche est effectuée dans Outlook d'où la présence de DoEvents dans la proc "TestAdvancedSearchComplete" afin de laisser la recherche se faire complètement. Je pense que ceci n'est valable que dans le VBE d'Outlook et comme tu veux faire cette manip depuis Excel il te faut adapter et donc virer le DoEvents qui boucle sans fin car la variable "blnSearchComp" ne sera jamais à True puisque la proc évennementielle "Application_AdvancedSearchComplete" qui la mets à True n'est pas exécuter. Je viens de tester ceci qui me retourne les noms des expéditeurs avec le contenu des messages, adapte :

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
 
Sub TestAdvancedSearchComplete()
 
    Dim olApp As Outlook.Application
    Dim sch As Outlook.Search
    Dim rsts As Outlook.Results
    Dim I As Integer
 
    Set olApp = New Outlook.Application
 
    Set sch = olApp.AdvancedSearch("inbox")
 
    Set rsts = sch.Results
 
    For I = 1 To rsts.Count
        'Subject = sujet
        'SenderEmailAddress = adresse complète
        'SenderName = nom de l'expéditeur (champ De)
        'Body = corp du message
 
        Debug.Print rsts.Item(I).SenderName
        Debug.Print rsts.Item(I).Body
 
    Next
 
End Sub

Hervé.

[jean.cdc]

Merci Hervé pour cette réponse.

J'ai adapté mon programme comme ci-dessous mais le résultat n'est pas le même lorsque je l'exécute en mode Pas à pas détaillé (F8) ou en mode normal (bouton Exécuter Sub/UserForm).

Je souhaite compter les mails contenant en objet le mot TEST à la date du 09/02/2011.

- mode pas à pas détaillé : le nombre est correct
- mode normal : 0

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
Sub RechercheMail()
 
Dim olApp As Outlook.Application
Dim olNameSpace As Outlook.Namespace
Dim olDossier As Outlook.MAPIFolder
Dim olSearch As Outlook.Search
Dim olResult As Outlook.Results
Dim Scope As String
Dim Filter As String
 
Set olApp = CreateObject("Outlook.Application")
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olDossier = olNameSpace.GetDefaultFolder(olFolderInbox)
 
Scope = "'" & olDossier.FolderPath & "'"
 
Filter = "urn:schemas:httpmail:subject LIKE '%TEST%'" & _
     "AND urn:schemas:httpmail:datereceived >= '09/02/2011 00:00'" & _
     "AND urn:schemas:httpmail:datereceived <= '09/02/2011 23:59'"
 
Set olSearch = olApp.AdvancedSearch(Scope, Filter)
 
Set olResult = olSearch.Results
 
Debug.Print olResult.Count
 
Set olResult = Nothing
Set olSearch = Nothing
Set olApp = Nothing
 
End Sub

As-tu une idée ?

[Godzestla]

Si le résultat est > 0 en mode pas à pas, et à 0 en normal, c'est un problème de vitesse et de synchro.

Essaie avec Doevents après la soumisison de ton AdvancedSearch, sinon essaie un Application.wait de qq secondes.

[Theze]

Re,
Chez moi, en lançant la proc j'ai eue tout de suite les résultats mais peut être que les performences de PC y sont pour quelques chose ? Comme le dis Godzestla, il te faut marquer une pose entre le lancement de la recherche et la demande du résultat. Insère la ligne "Minuterie 2000
" entre les deux instructions suivantes :

Code :

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

1
2
3
4
5
6
7
 
Set olSearch = olApp.AdvancedSearch(Scope, Filter)
 
'pose de 2 secondes
Minuterie 2000
 
Set olResult = olSearch.Results

et met ceci en tête de module :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Private Declare Function GetTickCount Lib "Kernel32" () As Long
 
Sub Minuterie(Milliseconde As Long)
 
    Dim Arret As Long
 
    Arret = GetTickCount() + Milliseconde
 
    Do While GetTickCount() < Arret
        DoEvents
    Loop
 
End Sub

Hervé.

[jean.cdc]

Bonjour et merci à vous deux.

Cela fonctionne après avoir rajouter la temporisation.

Le problème que j'ai maintenant est pour lire les emails d'une autre boite aux lettres (TOTO) qui n'est pas ma boite personnelle mais à laquelle j'ai bien accès.

J'ai donc modifié la ligne suivante :

Code :

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

Set olDossier = olNameSpace.GetDefaultFolder(olFolderInbox)

par :

Code :

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

Set olDossier = olNameSpace.Folders(BOITE_AUX_LETTRES).Folders(DOSSIER_A_LIRE)

Avec comme valeur :

Code :

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

1
2
Const BOITE_AUX_LETTRES As String = "Boîte aux lettres - TOTO"
Const DOSSIER_A_LIRE As String = "Boîte de réception"

Mais je n'obtiens pas le bon comptage. La valeur retournée est le nombre total de mails du dossier "Boîte de réception". Mon filtre est toujours le même que j'ai indiqué dans mon message précédent. Cette méthode fonctionne correctement si j'indique le nom de ma boite aux lettres personnels

Quelqu'un aurait une idée ?

Merci d'avance.

[jean.cdc]

Bonjour,

Personne pour m'aider ?

Merci d'avance à ceux qui pourront me débloquer.