angel_if
01-03-2019, 07:53 AM
Hi all. I have some problem wirh VBScript .I want to write a script that creates folders and then creates rules for these folders and I do not want that the code would be so long (more then 1.5 k). Vbscripts do not support OOP. Someone can help? I have 26 folder and for all needs rule.
SubCreateRule() 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 oSubjectCondition 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).Folders.Item("Folder")
'Assume that target folder already exists
Set oMoveTarget = oInbox.Folders("subfolder")
'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("subfolder_rule", olRuleReceive)
'Specify the exception condition for the subject in a TextRuleCondition object
'Exception condition is if the subject contains "fun" or "chat"
Set oSubjectCondition = _
oRule.Conditions.Subject
With oSubjectCondition
.Enabled = True
.Text = Array("hello")
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
SubCreateRule() 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 oSubjectCondition 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).Folders.Item("Folder")
'Assume that target folder already exists
Set oMoveTarget = oInbox.Folders("subfolder")
'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("subfolder_rule", olRuleReceive)
'Specify the exception condition for the subject in a TextRuleCondition object
'Exception condition is if the subject contains "fun" or "chat"
Set oSubjectCondition = _
oRule.Conditions.Subject
With oSubjectCondition
.Enabled = True
.Text = Array("hello")
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