Macro Outlook pour executer mes règles sur messages sélectionnés
maxoudu35
-
maxoudu35 -
maxoudu35 -
Bonjour,
Je cherche à crée une macro pour executer via un bouton toutes mes règles qui sont par défaut la plupart désactivées, cela pour me permettre de voir tout mes mails dans mon dossier boite de reception avant de les trier. J'ai donc trouver une Macro sur le Net, mais avec mes 25 règles qui s'appliquent sur tous mes mails dans ma boite, cela met plus de 2 minutes. L'idée est donc de faire en sorte que cela s'exécute uniquement sur les 3 derniers jours en les sélectionnant. J'ai essayer de faire un mélange avec d'autres macros qui utilisent uniquement les mails selectionnés mais en vain...
Merci d'avance pour vos idées et conseils
Voici la macro original :
Je cherche à crée une macro pour executer via un bouton toutes mes règles qui sont par défaut la plupart désactivées, cela pour me permettre de voir tout mes mails dans mon dossier boite de reception avant de les trier. J'ai donc trouver une Macro sur le Net, mais avec mes 25 règles qui s'appliquent sur tous mes mails dans ma boite, cela met plus de 2 minutes. L'idée est donc de faire en sorte que cela s'exécute uniquement sur les 3 derniers jours en les sélectionnant. J'ai essayer de faire un mélange avec d'autres macros qui utilisent uniquement les mails selectionnés mais en vain...
Merci d'avance pour vos idées et conseils
Voici la macro original :
Sub AppliRègles()
Dim objOutlook As Outlook.Application
Dim Banque As Store
Dim LesBanques As Stores
Dim Règle As Rule
Dim LesRègles As Rules
Dim NbRègles As Integer
Dim NbRèglesEx As Integer
Set objOutlook = Outlook.Application
NbRèglesEx = 0
Set LesBanques = objOutlook.Session.Stores
For Each Banque In objSelection
On Error GoTo Suite
NbRègles = Banque.GetRules.Count
On Error GoTo 0
Set LesRègles = Banque.GetRules
For Each Règle In LesRègles
If Not Règle.Enabled Then
' If Règle.Enabled Then CA C'ETAIT L'ORIGINAL
Règle.Execute
NbRèglesEx = NbRèglesEx + 1
End If
Next Règle
GoTo Boucle
Suite:
Debug.Print "La banque " & Banque.DisplayName & " ne supporte pas les règles """
Resume Boucle
Boucle:
Next Banque
MsgBox NbRèglesEx & " appliquées, tout est bien rangé !"
End Sub
2 réponses
-
ERRATUM SUR LE CODE DEPOSE !!
Sub AppliRègles() Dim objOutlook As Outlook.Application Dim Banque As Store Dim LesBanques As Stores Dim Règle As Rule Dim LesRègles As Rules Dim NbRègles As Integer Dim NbRèglesEx As Integer Set objOutlook = Outlook.Application NbRèglesEx = 0 Set LesBanques = objOutlook.Session.Stores For Each Banque In LesBanques On Error GoTo Suite NbRègles = Banque.GetRules.Count On Error GoTo 0 Set LesRègles = Banque.GetRules For Each Règle In LesRègles If Not Règle.Enabled Then Règle.Execute NbRèglesEx = NbRèglesEx + 1 End If Next Règle GoTo Boucle Suite: Debug.Print "La banque " & Banque.DisplayName & " ne supporte pas les règles" Resume Boucle Boucle: Next Banque MsgBox NbRèglesEx & " appliqué(e)s " End Sub -