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

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

I am trying to make a macro in Outlook that will put a category on all the e-mails that have the same first 15 characters of the subject.

要查找具有相同 Subject 字符串（前 15 个字符）的所有项，您可以使用 Find/FindNext 或 Restrict 方法15=] class。在以下文章中阅读有关这些方法的更多信息：

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 returns 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 集合（请参阅 [=19= 的 Items 属性 ] class 在 Outlook 中）。
完全支持 DASL 查询（自定义属性也可用于搜索）。您可以在 MSDN 的 Filtering 文章中阅读更多相关信息。为了提高搜索性能，如果为商店启用了即时搜索，则可以使用即时搜索关键字（请参阅 Store class 的 IsInstantSearchEnabled 属性）。
您可以随时使用 Search class 的 Stop 方法停止搜索过程。

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

Answer 2

事实证明这比第一次出现时更棘手。

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
“在特定情况下这很有用。大多数时候你应该避免使用它。”

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

Categorise e-mails by part of subject

search

outlook

vba