使用 excel vba 将 n 个 outlook 项目加入一个新对象

Join n outlook items into one new object with excel vba

我正在 Excel 的 n 个 outlook 文件夹中查找来自某人 x 的电子邮件 VBA。我想要做的是找到 n 个结果(或更多文件夹)中的最新项。

我考虑合并 n 个对象,按 ReceivedTime 排序,然后获取最前面的项目,但我无法合并它们,也无法找到 n 个对象中最近的对象。

示例是 2 个文件夹,2 个项目:

    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 = "somebody@outlook.com"
         
        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)

首先,如果你想得到排序的项目,你需要在运行使用Find/FindNext方法的Restrict之前对集合进行排序。

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 &"'"`

您似乎需要使用 Application class 的 AdvancedSearch 方法,它根据指定的 DAV 搜索和定位 (DASL) 搜索字符串执行搜索。您可以 运行 一次在多个文件夹中搜索。所以,没有必要运行为每个文件夹单独搜索:

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

您可以 运行 为所有文件夹搜索一次,搜索在后台执行。在 Outlook 中使用 AdvancedSearch 方法的主要好处是:

  • 搜索在另一个线程中执行。您不需要手动 运行 另一个线程,因为 AdvancedSearch 方法 运行 它会自动在后台运行。
  • 可以在任何位置(即超出某个文件夹的范围)搜索任何项目类型:邮件、约会、日历、便笺等。 RestrictFind/FindNext 方法可以应用于特定的 Items 集合(参见 [=25= 的 Items 属性 ] class 在 Outlook 中)。
  • 完全支持 DASL 查询(自定义属性也可用于搜索)。为了提高搜索性能,如果为商店启用了即时搜索,则可以使用即时搜索关键字(请参阅 Store class 的 IsInstantSearchEnabled 属性)。
  • 您可以随时使用 Search class 的 Stop 方法停止搜索过程。

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

您可以比较搜索结果。

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 = "somebody@outlook.com"
    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