使用子文件夹名称自动分类电子邮件答案

【问题标题】：Auto Categorize Emails using Subfolder Names使用子文件夹名称自动分类电子邮件
【发布时间】：2021-08-24 06:56:14
【问题描述】：

我有一个包含多个子文件夹的共享收件箱。

我想使用子文件夹名称作为相关子文件夹中每封电子邮件的类别，而不是为每个文件夹创建类别和规则。

例如，我想将“支持”中的电子邮件自动分类为“项目 A - 支持”，将“项目 A”中的电子邮件自动分类为“项目 A”

收件箱
- 项目A
  - 支持
- 项目 B
- 项目 C

Private WithEvents Items As Outlook.Items

Private Const AUTO_CATEGORY As String = "(test)"

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Dim Inbox As Outlook.MAPIFolder
  Dim Subfolder As Outlook.MAPIFolder

  Set Ns = Application.GetNamespace("MAPI")

  Set Inbox = Ns.GetDefaultFolder(olFolderInbox)

  Set Subfolder = Inbox.Folders

  Set Items = Subfolder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
  Dim Cats() As String
  Dim i&
  Dim Exists As Boolean

  If Len(Item.Categories) Then
    Cats = Split(Item.Categories, ";")
    For i = 0 To UBound(Cats)
      If LCase$(Cats(i)) = LCase$(AUTO_CATEGORY) Then
        Exists = True
        Exit For
      End If
    Next

    If Exists = False Then
      Item.Categories = Item.Categories & ";" & AUTO_CATEGORY
      Item.Save
    End If

  Else
    Item.Categories = AUTO_CATEGORY
    Item.Save
  End If
End Sub

【问题讨论】：

到目前为止你尝试过什么代码？
@EugeneAstafiev 我知道的代码让我将移动或接收的电子邮件与我在脚本中编写的特定类别进行分类。我不知道是否有代码可以做我需要的。
您能否发布您迄今为止开发的代码，以便我们提出所需的更改建议？
@EugeneAstafiev，我按照你的要求发布了代码。

标签： vba outlook

【解决方案1】：

ItemAdd 和规则一样乏味。您需要每个文件夹的代码。

Option Explicit

Private WithEvents SubfolderProjectAItems As Items
Private WithEvents SubfolderProjectASupportItems As Items

Private WithEvents SubfolderProjectBItems As Items
Private WithEvents SubfolderProjectCItems As Items


Private Sub Application_Startup()

    Dim myInbox As folder
    
    Dim SubfolderProjectA As folder
    Dim SubfolderProjectASupport As folder
    
    Dim SubfolderProjectB As folder
    Dim SubfolderProjectC As folder
    
    Set Inbox = Session.GetDefaultFolder(olFolderInbox)
    
    Set SubfolderProjectA = Inbox.folders("Project A")
    Set SubProjectAItems = SubfolderProjectA.Items
    
    Set SubfolderProjectASupport = SubfolderProjectA.folders("Support")
    Set SubfolderProjectASupportItems = SubfolderProjectASupport.Items
    
    Set SubfolderProjectB = Inbox.folders("Project B")
    Set SubfolderProjectBItems = SubfolderProjectB.Items
    
    Set SubfolderProjectC = Inbox.folders("Project C")
    Set SubfolderProjectCItems = SubfolderProjectC.Items
  
End Sub


Private Sub testPA()
    SubfolderProjectA_ItemAdd ActiveInspector.currentItem
End Sub


Private Sub SubfolderProjectA_ItemAdd(ByVal Item As Object)
    
    Dim catStr As String
    
    catStr = Item.Parent
        
    If InStr(Item.categories, catStr) = 0 Then
        Item.categories = Item.categories & ";" & catStr
        Item.Save
    End If

End Sub


Private Sub testPASupport()
    SubfolderProjectASupportItems_ItemAdd ActiveInspector.currentItem
End Sub

Private Sub SubfolderProjectASupportItems_ItemAdd(ByVal Item As Object)

    Dim catStr As String
    
    catStr = Item.Parent.Parent & " - " & Item.Parent
    
    If InStr(Item.categories, catStr) = 0 Then
        Item.categories = Item.categories & ";" & catStr
        Item.Save
    End If
    
End Sub

【讨论】：