Creating Outlook folders and rules using VBA

I am trying to create a folder in the Inbox for each unique sender of selected email(s), and a rule to move future messages from those senders to the appropriate folders.

Sub CreateSenderFolderAndRule()
    Dim objNS As Outlook.NameSpace
    Dim objInbox As Outlook.MAPIFolder
    Dim objMail As Outlook.MailItem
    Dim objSenderFolder As Outlook.MAPIFolder
    Dim strFolderName As String
    Dim objRules As Outlook.Rules
    Dim objRule As Outlook.Rule
    Dim objCondition As Outlook.RuleCondition
    Dim objAction As Outlook.RuleAction
    Dim objRuleExec As Object
    
    ' Get reference to the inbox
    Set objNS = Application.GetNamespace("MAPI")
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
    
    ' Check if there is a selected item
    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox "Please select a message to create a folder for."
        Exit Sub
    End If
    
    ' Get the selected item (should be a mail item)
    Set objMail = Application.ActiveExplorer.Selection.Item(1)
    
    ' Check if the sender of the email is already a folder
    On Error Resume Next
    Set objSenderFolder = objInbox.Folders(objMail.SenderName)
    On Error GoTo 0
    
    ' If the folder does not exist, create it
    If objSenderFolder Is Nothing Then
        ' Create a folder with the name of the sender
        strFolderName = objMail.SenderName
        Set objSenderFolder = objInbox.Folders.Add(strFolderName, olFolderInbox)
    End If
    
    ' Create a rule to move new messages from the sender to the new folder
    Set objRules = Application.Session.DefaultStore.GetRules()
    
    ' Temporarily disable all existing rules
    Dim objExistingRule As Outlook.Rule
    For Each objExistingRule In objRules
        objExistingRule.Enabled = False
    Next objExistingRule
    
    ' Create the new rule
    Set objRule = objRules.Create("Move messages from " & objMail.SenderName, olRuleReceive)
    Set objCondition = objRule.Conditions.SenderAddress
    With objCondition
        .Enabled = True
        .Address = objMail.SenderEmailAddress
    End With
    Set objAction = objRule.Actions.MoveToFolder
    With objAction
        .Enabled = True
        .ExecutionOrder = 1 ' Ensure the rule is executed before other rules
        .Folder = objSenderFolder
    End With
    objRule.Enabled = True
    
    ' Re-enable the existing rules
    For Each objExistingRule In objRules
        objExistingRule.Enabled = True
    Next objExistingRule
    
    ' Save the rules
    objRules.Save
    
    ' Debugging code to check the rules after the new one has been created
    Debug.Print "Number of rules: " & objRules.Count
    For Each objExistingRule In objRules
        Debug.Print objExistingRule.Name & " - " & objExistingRule.Enabled
    Next objExistingRule
    
    ' Execute the rule
    Set objRuleExec = Application.Session.DefaultStore.GetRules.ExecuteRule(objRule.Name)
    
    ' Success message
    MsgBox "Created folder: " & objSenderFolder.Name & vbCrLf & "Created rule: " & objRule.Name
End Sub

A new folder is created for the sender of the selected email(s), but no new rule is created, and I don't get the success message.

I get

>Run-time error '438: Object doesn't support this property or method

on the line

Set objCondition = objRule.Conditions.SenderEmailAddress 

I'm using Outlook 365 (version 2103) on a Windows 10 machine, and running the macro from the VBA editor in Outlook.

I tried various changes to the code, including different RuleCondition parameters, changing the FilterType property, and using different folder creation methods.

Store Rules object in a dedicated variable and call Rules.Save after you are done:

set objRules = Application.Session.DefaultStore.GetRules()
Set objRule = objRules.Create("Move messages from " & objMail.SenderName, olRuleReceive)
...
objRules.Save

After you enable a rule, you must also save the rule by using Rules.Save so that the rule and its enabled state will persist beyond the current session. A rule is only enabled after it has been saved successfully.

Be aware, saving rules that are incompatible or have improperly defined actions or conditions will return an error.

Also Rules.Save can be an expensive operation in terms of performance on slow connections to Exchange server. For more information on using the progress dialog box, see Manage Rules in the Outlook Object Model.

For example, the following VBA macro moves messages from a specific sender to a specific folder, unless the message contains certain terms in the subject:

Sub CreateRule() 
    Dim colRules As Outlook.Rules 
    Dim oRule As Outlook.Rule 
    Dim colRuleActions As Outlook.RuleActions 
    Dim oMoveRuleAction As Outlook.MoveOrCopyRuleAction 
    Dim oFromCondition As Outlook.ToOrFromRuleCondition 
    Dim oExceptSubject As Outlook.TextRuleCondition 
    Dim oInbox As Outlook.Folder 
    Dim oMoveTarget As Outlook.Folder 
 
    'Specify target folder for rule move action 
    Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox) 
    'Assume that target folder already exists 
    Set oMoveTarget = oInbox.Folders("Eugene") 
     
    'Get Rules from Session.DefaultStore object 
    Set colRules = Application.Session.DefaultStore.GetRules() 
     
    'Create the rule by adding a Receive Rule to Rules collection 
    Set oRule = colRules.Create("Dan's rule", olRuleReceive) 
 
    'Specify the condition in a ToOrFromRuleCondition object 
    'Condition is if the message is from "Dan Wilson" 
    Set oFromCondition = oRule.Conditions.From 
    With oFromCondition 
        .Enabled = True 
        .Recipients.Add ("Eugene Astafiev") 
        .Recipients.ResolveAll 
    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 
 
    'Specify the exception condition for the subject in a TextRuleCondition object 
    'Exception condition is if the subject contains "fun" or "chat" 
    Set oExceptSubject = _ 
        oRule.Exceptions.Subject 
    With oExceptSubject 
        .Enabled = True 
        .Text = Array("fun", "chat") 
    End With 
 
    'Update the server and display progress dialog 
    colRules.Save 
End Sub