按部分主题对电子邮件进行分类

Question

我正在尝试对主题前 15 个字符相同的所有电子邮件进行分类。

我有一个脚本（我在这里借用了 Macro in Outlook to delete duplicate emails-），它可以比较电子邮件的主题和正文，找到重复项并将它们移动到已删除邮件中。

我想修改它以仅比较主题的前 15 个字符并对电子邮件进行分类而不是删除它们。

Option Explicit

'Set a reference to the Microsoft Scripting Runtime from Tools, References.

Sub CategorizeDuplicateEmailsInSelectedFolder()

Dim i As Long
Dim n As Long
Dim Message As String
Dim Items As Object
Dim AppOL As Object
Dim NS As Object
Dim Folder As Object

Set Items = CreateObject("Scripting.Dictionary")

'Initialize and instance of Outlook
Set AppOL = CreateObject("Outlook.Application")

'Get the MAPI Name Space
Set NS = AppOL.GetNamespace("MAPI")

'Allow the user to select a folder in Outlook
Set Folder = NS.PickFolder

'Get the count of the number of emails in the folder
n = Folder.Items.Count

'Check each email starting from the last and working backwards to 1
'Loop backwards to ensure that the deleting of the emails does not interfere with subsequent items in the loop
For i = n To 1 Step -1

    On Error Resume Next
    'Load the matching criteria to a variable
    'This is setup to use the Subject
    Message = Folder.Items(i).Subject <- this part needs to be modifed

        'Check a dictionary variable for a match
        If Items.Exists(Message) = True Then
        'If the item has previously been added then categorize this duplicate
        Folder.Items(i).Categories = "Blue category" <- this part needs to be modifed
    Else
        'In the item has not been added then add it now so subsequent matches will be categorized
        Items.Add Message, True
End If

Next i

ExitSub:

'Release the object variables from memory
Set Folder = Nothing
Set NS = Nothing
Set AppOL = Nothing

End Sub

Answer 1

事实证明这比最初出现的要复杂。

Option Explicit

'Set a reference to the Microsoft Scripting Runtime from Tools, References.

Sub CategorizeDuplicateEmailsInSelectedFolder()

Dim i As Long
Dim n As Long

Dim startSubject As String
Dim dictItems As Object

Dim pFolder As Object
Dim pFolderItems As Items
Dim msgObj As mailItem

Set dictItems = CreateObject("Scripting.Dictionary")

'Allow the user to select a folder in Outlook
Set pFolder = Session.PickFolder
If pFolder Is Nothing Then Exit Sub

Set pFolderItems = pFolder.Items

'Get the count of the number of emails in the folder
n = pFolderItems.Count

pFolderItems.Sort "[ReceivedTime]", True

'Check each email starting from the oldest
For i = n To 1 Step -1

    If TypeName(pFolderItems(i)) = "MailItem" Then
    
        Set msgObj = pFolderItems(i)
        
        'Load the matching criteria to a variable
        'This is setup to use the Subject
        'Message = Folder.Items(i).subject ' <- this part needs to be modifed
        startSubject = Left(msgObj.subject, 15)
        Debug.Print startSubject
        
        'Check a dictionary variable for a match
        If dictItems.Exists(startSubject) = True Then
            'If the item has previously been added then categorize this duplicate
            
            'pFolderItems(i).categories = "Blue category" ' <- This did not save
            
            msgObj.categories = "Blue category" ' <- This could be saved
            msgObj.Save
            
        Else
            'In the item has not been added then add it now so subsequent matches will be categorized
            dictItems.Add startSubject, True
        End If
    End If
Next i

End Sub

https://excelmacromastery.com/vba-error-handling/#On_Error_Resume_Next
“在某些特定场合，这很有用。大多数时候你应该避免使用它。”

Answer 2

我正在尝试在 Outlook 中创建一个宏，它将为所有具有相同主题前 15 个字符的电子邮件添加一个类别。

要查找具有相同Subject 字符串（前15 个字符）的所有项目，您可以使用Items 类的Find/FindNext 或Restrict 方法。在以下文章中详细了解这些方法：

• How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
• How To: Use Restrict method to retrieve Outlook mail items from a folder

您也可以考虑使用Folder.GetTable 方法，该方法获得一个Table 对象，其中包含通过过滤器过滤的项目。 GetTable 返回一个 Table，其中为父 Folder 的文件夹类型设置了默认列。要修改默认列集，请使用Columns 集合对象的Add、Remove 或RemoveAll 方法。

Sub RestrictTableOfInbox() 
    Dim oT As Outlook.Table 
    Dim strFilter As String 
    Dim oRow As Outlook.Row 
     
    'Construct filter for Subject containing 'your_15_characters' 
    Const PropTag  As String = "https://schemas.microsoft.com/mapi/proptag/" 
    strFilter = "@SQL=" & Chr(34) & PropTag  _ 
        & "0x0037001E" & Chr(34) & " ci_phrasematch 'your_15_characters'" 
     
    'Do search and obtain Table on Inbox 
    Set oT = Application.Session.GetDefaultFolder(olFolderInbox).GetTable(strFilter) 
     
    'Print Subject of each returned item 
    Do Until oT.EndOfTable 
        Set oRow = oT.GetNextRow 
        Debug.Print oRow("Subject") 
    Loop 
End Sub

您还可以查看Application.AdvancedSearch 方法，该方法基于指定的 DAV 搜索和定位 (DASL) 搜索字符串执行搜索。在 Outlook 中使用 AdvancedSearch 方法的主要好处是：

• 搜索在另一个线程中执行。您无需手动运行另一个线程，因为 AdvancedSearch 方法会在后台自动运行它。
• 可以在任何位置（即超出某个文件夹的范围）搜索任何项目类型：邮件、约会、日历、便笺等。 Restrict 和 Find/FindNext 方法可以应用于特定的 Items 集合（请参阅 Outlook 中 Folder 类的 Items 属性）。
• 完全支持 DASL 查询（自定义属性也可用于搜索）。您可以在 MSDN 中的 Filtering 文章中阅读有关此内容的更多信息。为了提高搜索性能，如果商店启用了即时搜索，则可以使用即时搜索关键字（请参阅Store 类的IsInstantSearchEnabled 属性）。
• 您可以随时使用Search 类的Stop 方法停止搜索过程。

在Advanced search in Outlook programmatically: C#, VB.NET 文章中阅读有关该方法的更多信息。