When I manually move an email to a #folder I want a popup asking me if I want to create a rule called #folder to always move mails from its #sender to the #folder.
I need to listen for BeforeItemMove event on the Inbox folder. In the handler, I need to conditionalty show a message box asking to create a rule. And then use the Outlook Rules API to create a rule.
I'm not good at all in VBA. I wrote:
unction BeforeItemMove(Item, MoveTo, Cancel) Dim Msg, Style, Title, Help, Ctxt, Response, MyString Msg = "Do you want to always move mails from this sender to this folder?" ' Define message. Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons. Title = "Create rule" ' Define title. Help = "DEMO.HLP" ' Define Help file. Ctxt = 1000 ' Define topic ' context. ' Display message. Response = MsgBox(Msg, Style, Title, Help, Ctxt) If Response = vbYes Then ' User chose Yes. MyString = "Yes" ' Perform some action. CreateRule (MoveTo) Else ' User chose No. MyString = "No" ' Perform some action. End If End Function 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(MoveTo) '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(MoveTo, olRuleReceive) 'Specify the condition in a ToOrFromRuleCondition object 'Condition is if the message is sent by "DanWilson" Set oFromCondition = oRule.Conditions.From With oFromCondition .Enabled = True .Recipients.Add (Sender) .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 'Update the server and display progress dialog colRules.Save End Sub




Reply With Quote