How to Create a Subfolder and Rule in Outlook using VBA

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.

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:

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

---