Hallo zusammen,
ich möchte mir einen VBA Code schreiben, beim dem in Outlook einzelne Regeln mit Kategorie-Bedingung aufgestellt werden. Mit Empfänger (ToOrFromRuleCondition) funktioniert das super, nur nicht mit Kategorien (CategoryRuleCondition). Ich benötige jedoch beide Bedingungen in den einzelnen Regelen.Ich würde mich sehr freuen, wenn Ihr eine Lösung hierfür wüsstet.
Probleme habe ich im folgenden Bereich meines Codes
'bisher Fehlerhaft: Ziel soll die Bedingung "E-Mail,welche die Kategorie "Ablegen" enthält, erstellen"
Set oCategoryCondition = oRule.Conditions.Category
With oCategoryCondition
.Enabled = True
.Categories.Add ("Ablegen")
End With
Hier mein gesamter aktueller Code:
Sub Regelerstellung()
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 oCategoryCondition As Outlook.CategoryRuleCondition
Dim oExceptSubject As Outlook.TextRuleCondition
Dim oInbox As Outlook.Folder
Dim oMoveTarget As Outlook.Folder
Dim sTxt As String
Dim sTxt2 As String
Dim sTxt3 As String
'Fragt den Ordner ab, in dem es abgelegt werden soll
sTxt = InputBox("Ordner:")
If sTxt = "" Then Exit Sub
'Fragt den Unterordner ab, in dem es abgelegt werden soll.
sTxt2 = InputBox("Unterordner:")
If sTxt2 = "" Then
Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set oMoveTarget = oInbox.Folders(sTxt)
Else
Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set oMoveTarget = oInbox.Folders(sTxt).Folders(sTxt2)
End If
'Regeln aufrufen
Set colRules = Application.Session.DefaultStore.GetRules()
'Fragt den Versender ab, der die E-Mail versendet
sTxt3 = InputBox("Versender:")
If sTxt3 = "" Then Exit Sub
'Erstellt einen neuen Regelname
Set oRule = colRules.Create(sTxt3 + "rule", olRuleReceive)
'Erstellt die Bedingung "E-Mail, die von "sTxt3" kommt"
Set oFromCondition = oRule.Conditions.From
With oFromCondition
.Enabled = True
.Recipients.Add (sTxt3)
.Recipients.ResolveAll
End With
'bisher Fehlerhaft: Ziel soll die Bedingung "E-Mail, welche die Kategorie "Ablegen" enthält, erstellen"
Set oCategoryCondition = oRule.Conditions.Category
With oCategoryCondition
.Enabled = True
.Categories.Add ("Ablegen")
End With
'erstellt Regel, dass E-Mail in den Ordner/Unterordner verschoben wird
Set oMoveRuleAction = oRule.Actions.MoveToFolder
With oMoveRuleAction
.Enabled = True
.Folder = oMoveTarget
End With
'nimmt die Regel auf
colRules.Save
End Sub
|