Can someone help me with following code to increase/faster outlook VBA Macro Speed ?

Hi

Can someone help me with following code to increase/faster outlook VBA Macro Speed ? Currently It taking lot of time run all email rules and getting process slow.

Code:

---

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

---

.
See if this improves things :

Code:

---

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


With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
End With


' 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


With Application
      .ScreenUpdating = True
        .DisplayStatusBar = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
End With


' 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

---

Thanks for your reply,

But I am getting debug/ run error while execution of above code at start of .ScreenUpdating

I am using this VBA code for outlook rule email or such booster can use with Excel spread sheet VBA macro ?

Quote:

---

Originally Posted by Logit

.
See if this improves things :

---

That looks like Excel. Probably won't work in Outlook

If you delete these lines, is it better?

Code:

---

        rl.Execute ShowProgress:=True
        count = count + 1

---

Or make ShowProgress := False