How to Create a Subfolder and Rule in Outlook using VBA

[chaplaindoug]

I want to use VBA to create a subfolder and a rule from code behind in Access 2013. I could use some coding examples.

1. In Outlook I have more than one account set up. I have two IMAP accounts and two Exchange accounts.

2. I want to create a subfolder under the Inbox of one of the Exchange accounts.

So, I need to know how to programmatically specify that I want the subfolder created under that specific Inbox. and I need to be able to create the rule to apply to just email associated with that Inbox. Any help will be appreciated. Thank you.

More specifically examples of VBA code to:

1. Create a sub folder called "Test Q" under the Inbox of an Exchange email account called "D-Doug.Pruiett."

2. Create a rule that directs incoming email with "Test Q" in its subject line to the sub folder created in step 1.

More specific help/examples would be great. Thanks for any help.

[chaplaindoug]

THE ANSWER
Okay. It wasn't easy. But hunt, peck, guess, agonize, and borrow and I cobbled together the following two routines that (1) create a subfolder of a subfolder of the Inbox of a specific Outlook email account, and (2) create a rule to send all incoming email with a specific text pattern in the subject line to the folder created in (1). Notes: Replace "emailaccount" with the name of the account you want to use. "Beta Tests" is a subfolder under the Inbox. If you want to just create a subfolder under the Inbox, remove the ".Item("Beta Tests"). . ." from the lines where it appears.


Here is the code:




Public Sub CreateFolder(ByVal FName As String)
Dim colStores As Outlook.Stores
Dim oStore As Outlook.Store
Dim oFolders As Outlook.folders
Dim oInbox As Outlook.Folder
On Error Resume Next

Set colStores = Outlook.Session.Stores
Set oFolders = colStores.Item("emailaccount").GetDefaultFolder(olFolderInbox).folders.Item("Beta Tests").folders
oFolders.Add (FName)

End Sub

Public Sub CreateRule(ByVal RName As String)
Dim colRules As Outlook.Rules
Dim oRule As Outlook.Rule
Dim colRuleActions As Outlook.RuleActions
Dim oRuleAction As Outlook.RuleAction
Dim oMoveRuleAction As Outlook.MoveOrCopyRuleAction
Dim oFromCondition As Outlook.ToOrFromRuleCondition
Dim oSubjectCondition As Outlook.TextRuleCondition
Dim oExceptSubject As Outlook.TextRuleCondition
Dim oInbox As Outlook.Folder
Dim oMoveTarget As Outlook.Folder
On Error Resume Next
'Specify target folder for rule move action
Set oInbox = Outlook.Session.Stores.Item("emailaccount").GetDefaultFolder(olFolderInbox).folders.Item("Beta Tests")
'Debug.Print oInbox.FolderPath
'Assume that target folder already exists
Set oMoveTarget = oInbox.folders(RName)
'Get Rules from Session.DefaultStore object
Set colRules = Outlook.Session.Stores.Item("emailaccount").GetRules()
'Create the rule by adding a Receive Rule to Rules collection
Set oRule = colRules.Create(RName, olRuleReceive)
'Specify the condition in a ToOrFromRuleCondition object
'Condition is if the message is sent by "DanWilson"
Set oSubjectCondition = oRule.Conditions.Subject
With oSubjectCondition
.Enabled = True
.Text = Array(RName)
End With
'Specify the action in a MoveOrCopyRuleAction object
'Action is to move the message to the target folder
Set oMoveRuleAction = oRule.Actions.MoveToFolder
With oMoveRuleAction
.Enabled = True
.Folder = oMoveTarget
End With
'Set rule to stop processing more rules
Set oRuleAction = oRule.Actions.Stop
With oRuleAction
.Enabled = True
End With
'Update the server and display progress dialog
colRules.Save
End Sub