如果主题在多个文本数组中的一个中匹配，则为传入邮件分配一个类别

Question

目标:ThisOutlookSession中的代码。
我错过了数组0的条件，其他数组(1到4)不是数组形式。请参阅下面的代码。其中Array 0 = #G126A， #G156A， #G186B， #GA265， #GH264A

IF the subject includes value in (array0)
THEN Exit
ELSEIF the subject includes value in (array1)
THEN assign category CAT1
ELSEIF the subject includes value in (array2)
THEN assign category CAT2
ELSEIF the subject includes value in (array3)
THEN assign category CAT3
ELSEIF the subject includes value in (array4)
THEN assign category CAT4

Option Explicit
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
lbl_Exit:
Exit Sub
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
If TypeName(item) = "MailItem" Then
AutoCategorize item
End If
lbl_Exit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Err.Clear
GoTo lbl_Exit
End Sub

在正常模块中输入以下代码的修改版本，然后重新启动Outlook(或手动运行Application_Startup)以激活事件。

Public Sub AutoCategorize(olItem As MailItem)
With olItem
If InStr(1, myitem.Subject, "100001") > 0 Or _
InStr(1, myitem.Subject, "103401") > 0 Or _
InStr(1, myitem.Subject, "108401") > 0 Or _
InStr(1, myitem.Subject, "800899") > 0 Or _
InStr(1, myitem.Subject, "800795") > 0 Or _
InStr(1, myitem.Subject, "800755") > 0 Or _
InStr(1, myitem.Subject, "800617") > 0 Or _
InStr(1, myitem.Subject, "850519") > 0 Or _
InStr(1, myitem.Subject, "212485") > 0 Then
olItem.Categories = "CAT1"
olItem.Save
ElseIf InStr(1, myitem.Subject, "800880") > 0 Or _
InStr(1, myitem.Subject, "221315") > 0 Or _
InStr(1, myitem.Subject, "004083") > 0 Or _
InStr(1, myitem.Subject, "218713") > 0 Or _
InStr(1, myitem.Subject, "800824") > 0 Or _
InStr(1, myitem.Subject, "004131") > 0 Or _
InStr(1, myitem.Subject, "800404") > 0 Or _
InStr(1, myitem.Subject, "020082") > 0 Or _
InStr(1, myitem.Subject, "212445") > 0 Then
olItem.Categories = "CAT2"
olItem.Save

ElseIf InStr(1, myitem.Subject, "215007") > 0 Or _
InStr(1, myitem.Subject, "215989") > 0 Or _
InStr(1, myitem.Subject, "005306") > 0 Or _
InStr(1, myitem.Subject, "004025") > 0 Or _
InStr(1, myitem.Subject, "060068") > 0 Or _
InStr(1, myitem.Subject, "060193") > 0 Or _
InStr(1, myitem.Subject, "030002") > 0 Or _
InStr(1, myitem.Subject, "060103") > 0 Or _
InStr(1, myitem.Subject, "217811") > 0 Then
olItem.Categories = "CAT3"
olItem.Save
ElseIf InStr(1, myitem.Subject, "060001") > 0 Or _
InStr(1, myitem.Subject, "215720") > 0 Or _
InStr(1, myitem.Subject, "030001") > 0 Or _
InStr(1, myitem.Subject, "030445") > 0 Or _
InStr(1, myitem.Subject, "030388") > 0 Or _
InStr(1, myitem.Subject, "030070") > 0 Or _
InStr(1, myitem.Subject, "060065") > 0 Or _
InStr(1, myitem.Subject, "601003") > 0 Or _
InStr(1, myitem.Subject, "203093") > 0 Then
olItem.Categories = "CAT4"
olItem.Save
End If
End With
lbl_Exit:
Exit Sub
End Sub

Answer 1

生成数组会很繁琐，但是可以这样做。

评论之前的回答:
"有些值在类别之间使用多次">

Private WithEvents Items As Items
Private Sub Application_Startup()
Set Items = Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
If TypeOf item Is MailItem Then
AutoCategorize item
End If
End Sub

Public Sub AutoCategorize(olItem As MailItem)
Dim array0 As Variant
Dim array1 As Variant
Dim array2 As Variant
Dim array3 As Variant
Dim array4 As Variant
Dim i As Long
array0 = Array("#G126A", "#G156A", "#G186B", "#GA265", "#GH264A")
For i = LBound(array0) To UBound(array0)
If InStr(olItem.Subject, array0(i)) Then
Exit Sub
End If
Next
array1 = Array("100001", "103401", "108401")
For i = LBound(array1) To UBound(array1)
If InStr(olItem.Subject, array1(i)) Then
olItem.categories = "CAT1"
Exit For
End If
Next
array2 = Array("800880", "221315", "004083")
For i = LBound(array2) To UBound(array2)
If InStr(olItem.Subject, array2(i)) Then
olItem.categories = olItem.categories & "; " & "CAT2"
Exit For
End If
Next
array3 = Array("215007", "215989", "005306")
For i = LBound(array3) To UBound(array3)
If InStr(olItem.Subject, array3(i)) Then
olItem.categories = olItem.categories & "; " & "CAT3"
Exit For
End If
Next
array4 = Array("060001", "215720", "030001")
For i = LBound(array4) To UBound(array4)
If InStr(olItem.Subject, array4(i)) Then
olItem.categories = olItem.categories & "; " & "CAT4"
Exit For
End If
Next
olItem.Save
End Sub

Answer 2

基本上，您可以编写四个循环来遍历数组中的所有项，如果主题包含包含数组项的子字符串，则分配一个类别。

For Each item In arrCategoryFour
If InStr(1, myitem.Subject, item) > 0 Then
olItem.Categories = "CAT1"
olItem.Save
End If
Next item

如果数组中的所有项在设计时都知道，那么手动创建Outlook规则不是更好吗?无论如何，你可能会发现在Office中开始使用VBA这篇文章很有帮助。