使用 Excel VBA 在 n 个 Outlook 文件夹中查找来自 x 的电子邮件

Question

我正在使用 Excel VBA 在 n 个 Outlook 文件夹中查找来自 x 的电子邮件。

我想要 n 个结果（或更多文件夹）中的最新项目。

我考虑合并n个对象，按

ReceivedTime

排序，然后获取顶部项目，但我无法管理它们的合并，或找到n个对象中最新的。

示例是两个文件夹、两个项目：

Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.Folder 'to be the inbox
Dim olArchive As Outlook.Folder 'my archive folder
Dim olItems As Outlook.Items
Dim olArchiveItems As Outlook.Items
Dim i As Long
Dim emailStr As String
Dim filter As String
Dim olSentFldr as Outlook.Folder

Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(6) ' olFolderInbox
Set olArchive = olNs.Folders(CStr(olNs.Accounts.Item(1)))

Set olSentFldr = olNs.GetDefaultFolder(olFolderSentMail)

emailStr = "[email protected]"
     
filter = "[SenderEmailAddress] = """ & emailStr & """"
Set olItems = olFldr.Items.Restrict(filter)
Set olArchiveItems = olArchive.Items.Restrict(filter)

olItems.Sort "[ReceivedTime]", True
olArchiveItems.Sort "[ReceivedTime]", True
olSentFldr.Sort "[ReceivedTime]", True

Dim olNew as Object 
   
' below hypothetical solution that does not work yet--------------
olNew = merge(olItems(1), olArchiveItems(1))
olNew.Sort "[ReceivedTime]", True
myOutcome = olNew(1)

Answer 1

您可以比较搜索结果。

Option Explicit

Private Sub mostRecentItem_MultipleSearches()

    ' Early Binding - requires reference to Microsoft Outlook XX.X Object Library
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.namespace
    
    Dim olFldr As Outlook.Folder 'to be the inbox
    Dim olSentFldr As Outlook.Folder
    
    Dim olFldrItems As Outlook.Items
    Dim olSentFldrItems As Outlook.Items
    
    Dim olItemRecent As Object
    
    Dim i As Long
    Dim emailStr As String
    Dim filter As String
    
    Set olApp = CreateObject("Outlook.Application")
    Set olNs = olApp.GetNamespace("MAPI")
    
    ' valid with early binding
    Set olFldr = olNs.GetDefaultFolder(olFolderInbox)   ' 6 if late binding
    Set olFldrItems = olFldr.Items
    Debug.Print "olFldrItems.count: " & olFldrItems.count
    
    emailStr = "[email protected]"
    filter = "[SenderEmailAddress] = """ & emailStr & """"
    
    olFldrItems.Sort "[ReceivedTime]", True
    Set olFldrItems = olFldrItems.Restrict(filter)
    Debug.Print "olFldrItems.count: " & olFldrItems.count
    
    Set olItemRecent = olFldrItems(1)
    'olItemRecent.Display
    
    Set olSentFldr = olNs.GetDefaultFolder(olFolderSentMail)
    Set olSentFldrItems = olSentFldr.Items
    olSentFldrItems.Sort "[SentOn]", True
    
    Debug.Print "olSentFldrItems.count: " & olSentFldrItems.count
    
    Debug.Print olItemRecent.ReceivedTime
    Debug.Print olSentFldrItems(1).SentOn
    
    If olItemRecent.ReceivedTime < olSentFldrItems(1).SentOn Then
         Set olItemRecent = olSentFldrItems(1)
    End If
    
    olItemRecent.Display

End Sub

Answer 2

首先，如果你想获得有序的项目，你需要在运行

Restrict

或

Find

/

FindNext

方法之前对集合进行排序。

olItems.Sort "[ReceivedTime]", True
olArchiveItems.Sort "[ReceivedTime]", True
olSentFldr.Sort "[ReceivedTime]", True

filter = "[SenderEmailAddress] = """ & emailStr & """"
Set olItems = olItems.Restrict(filter)
Set olArchiveItems = olArchiveItems.Restrict(filter)

尝试在搜索字符串中不使用直接比较：

filter = Chr(34) & "[SenderEmailAddress]" & Chr(34) & " like '%" & emailStr &"'"`

看起来您需要使用

AdvancedSearch

类的

Application

方法，该方法基于指定的 DAV 搜索和定位 (DASL) 搜索字符串执行搜索。您可以同时在多个文件夹中运行搜索。因此，无需为每个文件夹单独运行搜索：

Set olItems = olFldr.Items.Restrict(filter)
Set olArchiveItems = olArchive.Items.Restrict(filter)

您可以对所有文件夹运行一次，搜索将在后台执行。在 Outlook 中使用

AdvancedSearch

方法的主要好处是：

• 搜索是在另一个线程中执行的。您不需要手动运行另一个线程，因为

  AdvancedSearch

  方法会在后台自动运行它。
• 可以在任何位置（即超出特定文件夹的范围）搜索任何项目类型：邮件、约会、日历、笔记等。

  Restrict

  和

  Find

  /

  FindNext

  方法可应用于特定的

  Items

  集合（请参阅 Outlook 中

  Items

  类的

  Folder

  属性）。
• 完全支持 DASL 查询（自定义属性也可用于搜索）。为了提高搜索性能，如果商店启用了即时搜索，则可以使用即时搜索关键字（请参阅

  IsInstantSearchEnabled

  类的

  Store

  属性）。
• 您可以使用

  Stop

  类的

  Search

  方法随时停止搜索过程。

在

以编程方式在 Outlook 中进行高级搜索：C#、VB.NET

文章中了解有关 AdvancedSearch 方法的更多信息。