Outlook 2007 All E-mail Rules Executor

Nie wiem jak wy, ale ja jestem maniakiem jeżeli chodzi o porządnie posegregowaną pocztę e-mail. Może to wina tego, iż od Outlook 97 prowadzę archiwum poczty w plikach PST, w którym można znaleźć większość poczty e-mail jaką dostałem.

Niestety, obszerne archiwum wymaga także dużej ilości „zasad” (ang. rules i tak dalej będę tego używał) segregowania poczty, co z czasem zaczyna być coraz trudniejsze – dużo adresów się zmienia, tworzy się duplikaty, coś się skasuje nie potrzebnie i nagle nasz Inbox zawiera 1000 maili, które powinny być posortowane lub usunięte zgodnie ustawionym rule. Jeżeli nagle stwierdzimy, że należy uruchomić nasze rules dla danego folderu w celu jego posortowania, to okazuje się iż musimy kliknąć 500 razy strzałką w dół i 500 razy spacją by zaznaczyć wszystkie rules by się uruchomiły w danym katalogu.

Ja dzisiaj nie wytrzymałem, dlatego też popełniłem VBA :)

Poniżej znajdziecie gotowy kod, który umożliwi wam uruchamiania rules dla wybranego przez was folderu w Outlook 2007 (to jest WAŻNE, dopiero od Outlook 2007 można uruchamiać rules z poziomu VBA!!). Oczywiście kod jako plik txt załączony do postu. Mam nadzieję, że się to komuś przyda :)

' <summary>
'   Metoda przechodzi po wszystkich ustawionych rulach i wywoluje je
'   dla zaznaczonego przez uzytkownika katalogu.
' </summary>
Public Sub RunAllRules()
 
    ' Plik PST
    Dim oStore As Outlook.Store
    ' Kolekcja Ruli (kolekcja przypisana jest do pliku PTS (sic!))
    Dim colRules As Outlook.Rules
    ' Pojedynczy rule
    Dim oRule As Outlook.Rule
    ' Wybrany folder przez uzytkownika
    Dim oFolder As Outlook.Folder
    ' Liczba wywolanych ruli
    Dim count As Integer
    Dim includeSubFld As Boolean
 
    ' Prosba o wybranie folderu przez uzytkownika
    oFolder = Application.Session.PickFolder
 
    ' Jezeli uzytkownik kliknie cancel to wychodzimy z funkcji
    If TypeName(oFolder) = "Nothing" Then
        Exit Sub
    End If
 
    ' Sprawdzamy czy jest jakis podfolder
    If oFolder.Folders.count > 0 Then
        ' Jezeli jest to pytamy sie czy ma byc brany pod uwage podczas
        ' egzekucji rule
        If vbOK = MsgBox("Include subfolder in rule execution?", vbOKCancel, "Macro: RunAllRules") Then
            includeSubFld = True
        Else
            includeSubFld = False
        End If
    End If
 
    ' Pobieramy plik PST przypisany do folderu
    oStore = oFolder.Store
    ' A z niego kolekcje ruli
    colRules = oStore.GetRules
 
    ' Dla kazdego rule
    For Each oRule In oStore.GetRules
        ' Wywolujemy rule:
        ' jezeli nie chcemy miec pokazanego progress to ShowProgress ustawiamy na False
        oRule.Execute(ShowProgress:=True, Folder:=oFolder, IncludeSubfolders:=includeSubFld)
 
        ' Zwiekszamy licznik przejsc
        count = count + 1
 
    Next
 
    ' Infomujemy uzytkownika o zakonczeniu dzialania :)
    MsgBox(CStr(count) & " rules has been executed against " & oFolder.Name & " in " & oStore.DisplayName, vbInformation, "Macro: RunAllRules")
 
    oRule = Nothing
    oRules = Nothing
    oStore = Nothing
    oFolder = Nothing
 
End Sub