How to run rule against something other than Inbox with VBA?

[John]

Hi,

I'm trying to run a single rule against my "Junk E-mail" folder. Poking
around on forums, I twisted some code a bit to successfully run the rule
(albeit using what must be an inefficient loop to find the right rule).
However, it runs against the Inbox, and not Junk E-mail. I can't quite
figure out how to get it to run against the right folder. It must be the
Folder parm of the rl.Execute statement, but I don't know how to construct it.

Here is what I am doing:

Sub Kill_Junk()
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.Name = "Delete Most Junk Mail" Then
' if so, run it
rl.Execute ShowProgress:=True
End If
Next

Set rl = Nothing
Set st = Nothing
Set myRules = Nothing

End Sub

 

[Michael Bauer [MVP - Outlook]]

See the GetDefaultFolder function to get any default folder.

--
Best regards
Michael Bauer - MVP Outlook

: Outlook Categories? Category Manager Is Your Tool
: VBOffice Reporter for Data Analysis & Reporting
: <http://www.vboffice.net/product.html?pub=6&lang=en>


Am Tue, 10 Feb 2009 09:09:02 -0800 schrieb John:

 

[Ginnylou]

Just testing ability to Respond - tried to create a new request and it failed
- Ginnylou

 

[John]

Thanks, Michael. This worked great.
--
John

See the GetDefaultFolder function to get any default folder.

--
Best regards
Michael Bauer - MVP Outlook

: Outlook Categories? Category Manager Is Your Tool
: VBOffice Reporter for Data Analysis & Reporting
: <http://www.vboffice.net/product.html?pub=6&lang=en>


Am Tue, 10 Feb 2009 09:09:02 -0800 schrieb John:

 

[Justin]

Hello Michael, I am having the same issue as John, except I am trying to do
something slightly different. I would like to be able to take messages from
the sent items folder and send them to another designated folder after I have
sent an e-mail to a specific e-mail address. I am not great with VBA code and
so I am a little lost when you posted back to John and said (See the
GetDefaultFolder function to get any default folder). Could either you or
John explain or show me a routine that would work in this case.


Justin

 

[Michael Bauer [MVP - Outlook]]

See the ItemAdd event example in the VBA help file. Instead of watching the
Inbox you'd watch the SentItems folder, that's simply determined by the
constant passed to GetDefaultFolder.

In the event check the Recipients collection of the Item object passed to
ItemAdd. For instance, if Item.Recipients(1).Address is what you're looking
for, move the item to your target folder.

--
Best regards
Michael Bauer - MVP Outlook

: Outlook Categories? Category Manager Is Your Tool
: VBOffice Reporter for Data Analysis & Reporting
: <http://www.vboffice.net/product.html?pub=6&lang=en>


Am Tue, 3 Mar 2009 08:36:02 -0800 schrieb Justin:

 

[Justin]

Michael thanks for the reply...I looked at the ItemAdd event example, but it
shows how to take a contact and attach it to a new e-mail (I am unable to
figure out how to make that work for my situation). I have figured out how to
move a copy of the message from Sent Items to my specified folder and then go
back and delete the message out of sent items with the code I am going to
post here as "Delete" I still can't figure out how to get the messages in my
specified folder to a "Marked As Read" status. Also, I am going to post some
code that I have been working with to get the messages Marked as read and am
going to call it "Read" I need to essentially get the "Read" code to work and
then combine them if possible.

"Delete"



Dim WithEvents olkFolder As Outlook.Items

Private Sub Application_Quit()
Set olkFolder = Nothing
End Sub

Private Sub Application_Startup()
Set olkFolder =
Outlook.Application.Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub olkFolder_ItemAdd(ByVal Item As Object)
Dim olkRecipient As Outlook.Recipient
If Item.Class = olMail Then
For Each olkRecipient In Item.Recipients
'Change the address on the following line. Be sure to enter it
in all lower case.'
If LCase(olkRecipient.Address) = "(e-mail address removed)" Then
Item.Delete
Exit For
End If
Next
End If
End Sub



"Read"

Public WithEvents olkFolder1 As Outlook.Items

Private Sub Application_Quit()
Set olkFolder1 = Nothing
End Sub

Private Sub Application_Startup()
'Change the folder path on the following line as needed
Set olkFolder1 = OpenOutlookFolder("Mailbox - Test\test")
End Sub

Private Sub olkFolder1_ItemAdd(ByVal Item As Object)
Item.Unread = False
Item.Save
End Sub

Function IsNothing(obj)
If TypeName(obj) = "Nothing" Then
IsNothing = True
Else
IsNothing = False
End If
End Function

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
Dim arrFolders As Variant, _
varFolder As Variant, _
olkFolder As Outlook.MAPIFolder
On Error GoTo ehOpenOutlookFolder
If strFolderPath = "" Then
Set OpenOutlookFolder = Nothing
Else
If Left(strFolderPath, 1) = "\" Then
strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
End If
arrFolders = Split(strFolderPath, "\")
For Each varFolder In arrFolders
If IsNothing(olkFolder) Then
Set olkFolder = Session.Folders(varFolder)
Else
Set olkFolder = olkFolder.Folders(varFolder)
End If
Next
Set OpenOutlookFolder = olkFolder
End If
On Error GoTo 0
Exit Function
ehOpenOutlookFolder:
Set OpenOutlookFolder = Nothing

 

[blashmet]

See the GetDefaultFolder function to get any default folder.

Hi Michael,

I'm using a similar if not identical script (below).

I want the rule to recurse through all the subfolders of the inbox.

Do you know how I would accomplish this?

Thanks for your help.

Sub RunAllInboxRules()
Dim st As Outlook.Store
Dim myRules As Outlook.Rules
Dim rl As Outlook.Rule
Dim runrule As String
Dim rulename As String

rulename = "MarkNonEmployeeMailAsRead"

Set st = Application.Session.DefaultStore

Set myRules = st.GetRules

For Each rl In myRules

If rl.RuleType = olRuleReceive Then

If rl.Name = rulename Then
rl.Execute ShowProgress:=True
runrule = rl.Name

End If
End If
Next

ruleList = "This rule was executed against the Inbox:" & vbCrLf & runrule
MsgBox ruleList, vbInformation, "Macro: RunAllInboxRules"

Set rl = Nothing
Set st = Nothing
Set myRules = Nothing
End Sub