locked
Create an Outlook Sub Folder and Rule Using VBA Code Behind in Access 2013 RRS feed

  • Question

  • 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.

    Wednesday, June 22, 2016 1:01 AM

Answers

  • 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@abc.net" 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@abc.net").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@abc.net").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@abc.net").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




    • Marked as answer by Doug Pruiett Wednesday, June 22, 2016 4:38 PM
    • Edited by Doug Pruiett Wednesday, June 22, 2016 5:15 PM
    Wednesday, June 22, 2016 4:38 PM

All replies

  • Hi Doug Pruiett,

    According to your description, you could use Store.GetDefaultFolder method, this method is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile.

    For more information, click here to refer about Store.GetDefaultFolder Method (Outlook) and here to refer about Store Object (Outlook)

    Wednesday, June 22, 2016 9:17 AM
  • David et al:

    Thanks for the tip.  But this does not really provide me with the example I need.  Too high level for this intermediate programmer.  Tried coding a Store.GetDefaultFolder and it choked and spit it out, didn't recognise it.  I am hoping to get an example of VBA code that would:

    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.


    Wednesday, June 22, 2016 1:25 PM
  • 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@abc.net" 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@abc.net").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@abc.net").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@abc.net").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




    • Marked as answer by Doug Pruiett Wednesday, June 22, 2016 4:38 PM
    • Edited by Doug Pruiett Wednesday, June 22, 2016 5:15 PM
    Wednesday, June 22, 2016 4:38 PM