Regel zum Verschieben von E-Mails nach Absenderdomäne erstellen

Question

Ich kann derzeit das folgende Makro verwenden, um eine Regel zu erstellen, die alle E-Mails mit der ausgewählten Absenderadresse an einen bestimmten Ordner sendet.

Das funktioniert gut. Ich möchte jedoch die Regel erstellen, um alle E-Mails von dieser Domäne (unabhängig vom Absender) an den Ordner zu senden.

Hier ist der Code, den ich derzeit verwende.

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 oRuleCondition As Outlook.AddressRuleCondition 

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 = Application.Session.Folders("myinbox").Folders("Folders").Folders("Reference").Folders("Vendor Marketing") 

'Get Rules from Session.DefaultStore object 

Set colRules = Application.Session.DefaultStore.GetRules() 

Dim sSender As String 

For Each objItem In Application.ActiveExplorer.Selection 
     If objItem.Class = olMail Then 
     sSender = objItem.SenderEmailAddress 
     End If 
Next 

Dim domain() As String 
domain = Split(sSender, "@") 

Dim dDomain As String 
dDomain = "@" + domain(1) 

'Create the rule by adding a Receive Rule to Rules collection 
If MsgBox("Do you want to create a rule for " + sSender + "?", vbOKCancel) = vbOK Then 

    Set oRule = colRules.Create(sSender, olRuleReceive) 

    'Specify the condition in a ToOrFromRuleCondition object 
    Set oFromCondition = oRule.Conditions.From 
    With oFromCondition 
     .Enabled = True 
     .Recipients.Add (sSender) 
     .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 
    oRule.Execute ShowProgress:=True 
End If 

Answer 1

Ok, also nach viel mehr Ausgrabungen/Versuch und Irrtum. Ich habe eine Lösung gefunden. Die Hauptsache ist, dass der Typ "AddressRuleCondition" ist und die Eigenschaft, die Sie ändern möchten, nicht "Text" ist, sondern "Adresse"

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 oRuleCondition As Outlook.AddressRuleCondition <--------HERE 

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 = Application.Session.Folders("myinbox").Folders("Folders").Folders("Reference").Folders("Vendor Marketing") 

'Get Rules from Session.DefaultStore object 

Set colRules = Application.Session.DefaultStore.GetRules() 

Dim sSender As String 

For Each objItem In Application.ActiveExplorer.Selection 
     If objItem.Class = olMail Then 
     sSender = objItem.SenderEmailAddress 
     End If 
Next 

Dim domain() As String 
domain = Split(sSender, "@") 

Dim dDomain As String 
dDomain = "@" + domain(1) 

'Create the rule by adding a Receive Rule to Rules collection 
If MsgBox("Do you want to create a rule for " + dDomain + "?", vbOKCancel) = vbOK Then 

Set oRule = colRules.Create(dDomain, olRuleReceive) 

'Specify the condition in a ToOrFromRuleCondition object 
'Set oFromCondition = oRule.Conditions.From 
'With oFromCondition 
'.Enabled = True 
'.Recipients.Add (sSender) 
'.Recipients.ResolveAll 
'End With 

Set oRuleCondition = oRule.Conditions.SenderAddress 
With oRuleCondition 
    .Enabled = True 
    .Address = Array(dDomain)    <--------HERE 
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 
oRule.Execute ShowProgress:=True 
End If 

ist