PDA

View Full Version : VBA Script for Outlook - Run Rules



DavidHaley
01-29-2017, 12:27 PM
Okay, so...in Outlook, for some reason...spam makes it through my rules and hits my junk mailbox. If I run the rules manually...it catches them and deletes them. I don't want to have to go through the steps of clicking through the rule dialogue box in order to run all rules manually so...I'd like to have a script that I can put in my quick access toolbar. I know, I know...why worry about junk...well...I get some spam that has pretty offensive words in the subject from time-to-time and...I don't want those to even show up! Plus I get tons of spam in general and I don't want to have to look at 100's of email to determine whether or not any of them are not spam.

The script below is set up for the default mailbox, which is my work account...which I don't have to worry about...work has spam nailed down pretty well. I need the script below altered to work for a secondary account which is my Hotmail account. Can anyone help me out with this?

I didn't use tags because...for some reason it makes the script below look like gibberish!

Thank you in advance for you help!

***********************************************************
Sub RunAllInboxRules()
Dim st As Outlook.Store
Dim myRules As Outlook.Rules
Dim rl As Outlook.Rule
Dim count As Integer
Dim ruleList As String
‘On Error Resume Next’ get default store (where rules live)
Set st = Application.Session.DefaultStore
‘ get rules
Set myRules = st.GetRules
‘ iterate all the rules
For Each rl In myRules
‘ determine if it’s an Inbox rule
If rl.RuleType = olRuleReceive Then
‘ if so, run it
rl.Execute ShowProgress:=True
count = count + 1
ruleList = ruleList & vbCrLf & rl.Name
End If
Next
‘ tell the user what you did
ruleList = “These rules were executed against the Inbox: ” & vbCrLf & ruleList
MsgBox ruleList, vbInformation, “Macro: RunAllInboxRules”
Set rl = Nothing
Set st = Nothing
Set myRules = Nothing
End Sub
***********************************************************

gmayor
01-29-2017, 09:50 PM
In theory - though I cannot currently test it, replace
Set st = Application.Session.DefaultStorewith

Dim bST As Boolean
For Each st In Outlook.Session.Stores
If st.DisplayName = "Name of the store" Then
bST = True
Exit For
End If
Next st
If Not bST Then
MsgBox "The store " & st.DisplayName & " is not available"
Exit Sub
End If

DavidHaley
01-30-2017, 09:05 AM
Unfortunately...your code didn't work. The only changes I made to your script was...where it was stated "Name of Store" or "The Store"...I input my email address / the name of the email box. Any thoughts? :banghead::banghead::banghead:

skatonni
01-30-2017, 01:14 PM
Perhaps you are asking the wrong question. You can specify a non-default inbox folder to run rules.

.Execute(ShowProgress, Folder, IncludeSubfolders, RuleExecuteOption)

https://msdn.microsoft.com/en-us/library/office/ff864433.aspx

DavidHaley
01-30-2017, 02:16 PM
Perhaps you are asking the wrong question. You can specify a non-default inbox folder to run rules.

.Execute(ShowProgress, Folder, IncludeSubfolders, RuleExecuteOption)

https://msdn.microsoft.com/en-us/library/office/ff864433.aspx

Shesh! How do I incorporate what you're getting at with the script above? As you can tell...I'm a complete NOOB to Outlook VBA! If there was a recorder...I'd simply record the steps and BAM...done. All I want to do is have a button in the quick access toolbar that executes a "run all rules" instruction...so I don't have to go through all the clicks (yep...I'm lazy!).

gmayor
01-30-2017, 10:36 PM
The following macro will list the stores and the first level folders they contain in the immediate window


Sub Test()
Dim oStore As Store
Dim oFolder As Folder
For Each oStore In Session.Stores
For Each oFolder In oStore.GetRootFolder.folders
Debug.Print oStore & vbTab & oFolder
Next oFolder
Next oStore
End Sub


Use the correct name of the required store from the above macro in the following macro as the value of strName.


Sub RunAllInboxRules()
Dim st As Outlook.Store
Dim myRules As Outlook.Rules
Dim rl As Outlook.Rule
Dim count As Integer
Dim ruleList As String
Dim oStore As Store
Dim oFolder As Folder
Dim bStore As Boolean
Const strName As String = "Test SMTP"

On Error Resume Next
' get default store (where rules live)
Set st = Application.Session.DefaultStore
' get rules
Set myRules = st.GetRules
' iterate all the rules
For Each oStore In Session.Stores
If oStore.DisplayName = strName Then
bStore = True
Exit For
End If
Next oStore
If Not bStore Then
MsgBox "The store " & strName & " is not found"
Exit Sub
End If
For Each rl In myRules
' determine if it’s an Inbox rule
If rl.RuleType = olRuleReceive Then
' if so, run it
'rl.Execute ShowProgress:=True
rl.Execute ShowProgress:=True, _
Folder:=oStore.GetRootFolder.folders("Inbox"), _
IncludeSubfolders:=False, _
RuleExecuteOption:=olRuleExecuteAllMessages
count = count + 1
ruleList = ruleList & vbCrLf & rl.Name
End If
Next rl
' tell the user what you did
ruleList = "These rules were executed against the Inbox of " & strName & ": " & vbCrLf & ruleList
MsgBox ruleList, vbInformation, "Macro: RunAllInboxRules"
Set rl = Nothing
Set st = Nothing
Set myRules = Nothing
End Sub

DavidHaley
01-31-2017, 09:00 AM
Well...I think we're close! The problem is...when I ran the macro it applied the rules from my default box (which is my work account) to the Inbox of my Hotmail account (which is the secondary account). What I'm hoping for is...to apply the rules associated with my Hotmail account (secondary account) to all the folders within my Hotmail account. Let me know if you need further detail or maybe...a screen shot of Outlook.

Again...really appreciate the help...didn't know it would be this big of a pain!

skatonni
02-06-2017, 06:38 AM
I believe you would replace


' get default store (where rules live)
Set st = Application.Session.DefaultStore

with


' get non-default store (where rules live)
Set st = Application.Session.Stores(strName)