VBA Code to Create a Subfolder and Rule in Outlook

[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@abc.com."

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