VBA 搜索正文中包含子字符串的电子邮件

Question

与这样的教程相反（https://learn.microsoft.com/en-us/office/vba/outlook/How-to/Search-and-Filter/filtering-items-using-a-string-comparison ），% 通配符似乎没有为我做它应该做的事情。与 Outlook 本身的普通搜索非常相似，它仅返回该短语是独立单词的实例。例如：如果我在电子邮件正文中搜索“cat”，它不会返回包含“bobcats”的电子邮件

这是我写的代码，粗体线是字符串过滤器中使用%的地方。在我计划过滤的实际 Outlook 文件夹中，有一封电子邮件的正文中存在 ID 短语“WR2065416”。在我的代码中搜索整个短语“WR2065416”确实找到了电子邮件（带或不带％），但仅搜索“2065416”则什么也没有返回（同样带或不带%）。从我自己的尝试来看，潜在的问题似乎是，在此过滤器中，电子邮件正文与电子邮件主题的处理方式不同，因为将“文本描述”更改为“主题”使%开始努力查找任何内容所需的子字符串。

Sub OutlookKeywordSearch()

    ' Declarations
    
    Dim outlookApp As Outlook.Application
    Dim nSpace As Outlook.NameSpace
    Dim myFolder As Outlook.Folder
    Dim mail As Object
    Dim topPublicFolder As Outlook.Folder
    Dim myFolderItems
    Dim filtItems As Outlook.Items
    Dim strFilter As String
    Dim results As Integer
    Dim phrase As Variant
    
    Set outlookApp = Outlook.Application
    Set nSpace = Outlook.Application.GetNamespace("MAPI")
    Set topPublicFolder = nSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders)
    Set myFolder = topPublicFolder.Folders("ParentDirectory1").Folders("ParentDirectory2").Folders("ExampleFolder1")
    Set myFolderItems = myFolder.Items
    results = 0
    
    ' Phrase to search: 2065416
 
    ' Search in ExampleFolder1 for Given Phrase
        
**    strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & " like '%2065416%'"**
        
    Set filtItems = myFolder.Items.Restrict(strFilter)
    If filtItems.Count > 0 Then
        results = filtItems.Count
    End If
                
    MsgBox ("Found " + CStr(results) + " instances in ExampleFolder1 of this phrase!")
    results = 0

End Sub

Answer 1

我刚刚尝试在 Outlook 中运行以下代码来检查其工作原理：

Sub SearchMacro()
    On Error GoTo ErrorHandler
    Dim strFrom As String
    Dim strSearch As String
    Dim strSearchFolderName As String
    
    strSearchFolderName = "Search Macro"
    
    'Delete "Search Macro" Search Folder from a previous search
    Dim oSearchFolders As Outlook.Folders
    Dim oFolder As Outlook.Folder
    Set oSearchFolders = Outlook.Session.DefaultStore.GetSearchFolders
    
    For Each oFolder In oSearchFolders
        If oFolder.Name = strSearchFolderName Then
            oFolder.Delete
        End If
    Next

    'Prompt for Search Query
    strSearch = InputBox("Enter your search query: ", "Search Macro")

    'Search within the Subject and Message Body
    Dim strDASLFilter As String
    strDASLFilter = "urn:schemas:httpmail:textdescription LIKE '%" & strSearch & "%'"

    'Set search scope to the Inbox and Sent Items (will include subfolders)
    Dim strScope As String
    strScope = "'Inbox', 'Sent Items'"

    'Perform the search
    Dim objSearch As Search
    Set objSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder")

    'Save the search results to a Search Folder
    objSearch.Save (strSearchFolderName)
    
    'Add the Description and display the Search Folder in the current Outlook window
    Set oSearchFolders = Outlook.Session.DefaultStore.GetSearchFolders
    For Each oFolder In oSearchFolders
        If oFolder.Name = strSearchFolderName Then
            oFolder.Description = "You searched for: " & strSearch
            Set Application.ActiveExplorer.CurrentFolder = oFolder
        End If
    Next

    Set objSearch = Nothing
    Set oSearchFolders = Nothing
    Exit Sub

'Error handling
ErrorHandler:
MsgBox "Error: " & Err & vbNewLine & vbNewLine & Error(Err)

End Sub

我可以确认部分单词被正确找到。例如，要查找带有

account

字符串等的所有电子邮件，我输入

ccoun

字符串在相应的搜索文件夹中获得了正确的结果。