Utiliser AdvancedSearch sous VBA Excel pour lire les emails d'Outlook

Version imprimable

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:

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:

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.

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:

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

remplacement des balise [quote] (citation) par les balises [code]

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:

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 ?

15/02/2011, 16h21
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.

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:

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:

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

16/02/2011, 11h18
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:

Set olDossier = olNameSpace.GetDefaultFolder(olFolderInbox)

par :

Code:

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

Avec comme valeur :
Code:

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.
28/02/2011, 15h29
jean.cdc

Bonjour,

Personne pour m'aider ?

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