VBA BeforeItemMove event create rule to always move to its folder.

Status
Not open for further replies.

KadamWiser

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
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:
Code:
Function 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
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
In order to receive an event you need to declare a variable for the object with the With Events statement:
Code:
Private WithEvents Inbox As Outlook.Folder

Private Sub Application_Startup()
  Set Inbox = Application.Session.GetDefaultFolder(olFolderInbox)
End Sub

Now you can select the variable from the dropdown box upper left, then select the event you want from the one right hand.

Since the variable will be set in the Startup event, you need to restart Outlook after any code changes, or execute that method manually by placing the cursor into it, then pressing f5.
 

KadamWiser

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
I worked on it:

Code:
Private Sub Application_Startup()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
End Sub

Private Sub objFolder_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)
    BeforeItemMove Item, MoveTo, Cancel
End Sub

Function BeforeItemMove(Item As Outlook.MailItem, MoveTo As Folder, Cancel As Boolean)

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 Item, MoveTo
Else    ' User chose No.
    MyString = "No"    ' Perform some action.
End If
End Function

Sub CreateRule(Item As Outlook.MailItem, MoveTo As Folder)
 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.Name)

 '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)

 oRule.Name = "Test123"
 '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 (Item.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

Still not working :(
 

KadamWiser

New Member
Outlook version
Outlook 2016 64 bit
Email Account
Exchange Server
Code:
Private WithEvents objFolder As Outlook.Folder
Private Sub Application_Startup()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  Set objFolder = objNS.GetDefaultFolder(olFolderInbox)
End Sub

Private Sub objFolder_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)
    BeforeItemMove Item, MoveTo, Cancel
End Sub

Function BeforeItemMove(Item As Outlook.MailItem, MoveTo As Folder, Cancel As Boolean)

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 Item, MoveTo
Else    ' User chose No.
    MyString = "No"    ' Perform some action.
End If
End Function

Sub CreateRule(Item As Outlook.MailItem, MoveTo As Folder)
 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.Name)

 '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)

 oRule.Name = "Test123"
 '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 (Item.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
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Is objFolder_BeforeItemMove being called? You can test it by setting a breakpoint on to that line of code.
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
D Create advanced search (email) via VBA with LONG QUERY (>1024 char) Outlook VBA and Custom Forms 2
David McKay VBA to manually forward using odd options Outlook VBA and Custom Forms 1
FryW Need help modifying a VBA script for in coming emails to auto set custom reminder time Outlook VBA and Custom Forms 0
S vba outlook search string with special characters Outlook VBA and Custom Forms 1
S VBA search string with special characters Outlook VBA and Custom Forms 1
U Outlook 2019 VBA run-time error 424 Outlook VBA and Custom Forms 2
DDB VBA to Auto Insert Date and Time in the signature Outlook VBA and Custom Forms 2
F VBA to move email from Non Default folder to Sub folders as per details given in excel file Outlook VBA and Custom Forms 11
G VBA to save selected Outlook msg with new name in selected network Windows folder Outlook VBA and Custom Forms 1
F Excel VBA to move mails for outlook 365 on secondary mail account Outlook VBA and Custom Forms 1
B Zoom automatically next email item (VBA) Outlook VBA and Custom Forms 2
T vba extract data from msg file as attachment file of mail message Outlook VBA and Custom Forms 1
K Outlook Office 365 VBA download attachment Outlook VBA and Custom Forms 2
A VBA Script - Print Date between first email in Category X and last email in Category Y Outlook VBA and Custom Forms 3
N Help creating a VBA macro with conditional formatting to change the font color of all external emails to red Outlook VBA and Custom Forms 5
N Save selected messages VBA does not save replies and/or messages that contain : in subject Outlook VBA and Custom Forms 1
Y Filter unread emails in a search folder vba help Outlook VBA and Custom Forms 0
V vBA for searching a cell's contents in Outlook and retrieving the subject line Outlook VBA and Custom Forms 1
B vBA for exporting excel file from outlook 2016 Outlook VBA and Custom Forms 3
L Modifying VBA script to delay running macro Outlook VBA and Custom Forms 3
L Need help modifying a VBA script for emails stuck in Outbox Outlook VBA and Custom Forms 6
K can't get custom form to update multiple contacts using VBA Outlook VBA and Custom Forms 3
S Excel vba code to manage outlook web app Using Outlook 10
H Custom Outlook Contact Form VBA Outlook VBA and Custom Forms 1
S Problem Checking the available stores in my Inbox (Outlook VBA) Outlook VBA and Custom Forms 0
S Outlook VBA How to adapt this code for using in a different Mail Inbox Outlook VBA and Custom Forms 0
S Add VBA save code Using Outlook 0
C Auto Run VBA Code on new email Outlook VBA and Custom Forms 1
O VBA Cases with Listbox - Can you use Multi-Select? Outlook VBA and Custom Forms 4
O VBA Outlook Message Attachment - Array Index Out of Bounds Outlook VBA and Custom Forms 0
V Modifying the built in forms with VBA Outlook VBA and Custom Forms 4
S Excel VBA and shared calendar issue Outlook VBA and Custom Forms 3
L Macro/VBA to Reply All, with the original attachments Outlook VBA and Custom Forms 3
L VBA unknown character Outlook VBA and Custom Forms 2
G Move tasks up/down todo list by VBA Outlook VBA and Custom Forms 1
diver864 vba for a rule to automatically accept meeting requests with 'vacation' in subject, change to all-day event, change to free, don't send reply Outlook VBA and Custom Forms 1
K Use VBA to find Sender and Recipient from Microsfot 365 Journaled Email Items Outlook VBA and Custom Forms 3
J Want to learn VBA Macros for Outlook. What book can you recommend? Outlook VBA and Custom Forms 2
F VBA code to dock Styles whenever I write or edit an email Outlook VBA and Custom Forms 0
C VBA to prompt for Sent folder destination Outlook VBA and Custom Forms 3
B Adding signature to bottom of VBA reply email Outlook VBA and Custom Forms 1
B Change Font and Font size using VBA Outlook VBA and Custom Forms 9
M Outlook 2013 reminder email by using Outlook vba Outlook VBA and Custom Forms 2
D.Moore VBA script fail after Office 365 update Using Outlook 8
R Limiting length of saved attachment in VBA Outlook VBA and Custom Forms 2
S Skype for business meeting vba code Outlook VBA and Custom Forms 1
C How to use VBA to show only items x days old or more Outlook VBA and Custom Forms 1
B VBA to convert email to task, insert text of email in task notes, and attach copy of original email Outlook VBA and Custom Forms 4
D Outlook VBA error extracting property data from GetRules collection Outlook VBA and Custom Forms 10
S Reference Custom Fields with VBA Outlook VBA and Custom Forms 2

Similar threads

Top