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




Reply With Quote