Macro Outlook pour executer mes règles sur messages sélectionnés

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 :


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

  1. maxoudu35
     
    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
     
    
    0