使用Excel VBA搜索Outlook电子邮件（并回复）

我想在对话中搜索所有outlook中的最新消息（我使用主题名称作为搜索键）

此最新邮件可以位于收件箱、已发送邮件、收件箱的子文件夹、收件箱的子文件夹（任何位置）

我可以通过一些非常繁琐的代码来实现这一点，遍历每个主要文件夹的每个级别，但不仅这种方法非常混乱，我无法确定找到的消息是否是这次对话中的最新消息

我有下面的代码，它

-->在收件箱中搜索“searchKey”

-->如果在收件箱文件夹中找到它，请回复它

-->如果没有，它将移动到收件箱的子文件夹中，并继续相同的过程

Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olFldr As MAPIFolder
Dim olMail ' As Outlook.MailItem
Dim i As Integer

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set olFldr = Fldr

tryAgain:

    For Each olMail In olFldr.Items
        If InStr(olMail.Subject, searchKey) <> 0 Then
            Set ReplyAll = olMail.ReplyAll
            With ReplyAll
                .HTMLBody = Msg & .HTMLBody
                emailReady = True
                .Display
            End With
        End If
    Next olMail


If Not emailReady Then
    i = i + 1
    If i > Fldr.Folders.Count Then
        MsgBox ("The email with the given subject line was not found!")
        Exit Sub
    Else
        Set olFldr = Fldr.Folders(i)
        GoTo tryAgain
    End If
End If

Dim olApp作为Outlook.Application
Dim-olNs作为名称空间
将Fldr设置为MAPI文件夹
Dim olFldr作为MAPI文件夹
将“邮件”设置为Outlook.MailItem
作为整数的Dim i
Set olApp=newoutlook.Application
Set olNs=olApp.GetNamespace（“MAPI”）
设置Fldr=olNs.GetDefaultFolder（olFolderInbox）
设置olFldr=Fldr
tryAgain：
对于olFldr.项目中的每个olMail
如果InStr（olMail.Subject，searchKey）为0，则
Set replyll=olMail.replyll
答复
.HTMLBody=Msg和.HTMLBody
emailReady=True
.展示
以
如果结束
下一封邮件
如果没有准备好的话
i=i+1
如果i>Fldr.Folders.Count，则
MsgBox（“找不到具有给定主题行的电子邮件！”）
出口接头
其他的
设置olFldr=Fldr.文件夹（i）
GoTo tryAgain
如果结束
如果结束

这段代码可能会让人困惑和冗长，所以如果您需要任何澄清，请让我知道

问题是：如何在不手动搜索每个文件夹/子文件夹/子文件夹的情况下搜索所有Outlook。。。如果没有此方法，是否在特定对话中查找最后一条消息？或者，至少，我如何优化此代码，以便不丢失任何文件夹，并知道这些电子邮件的发送日期和时间？

您可以使用内置函数，该函数返回包含项目的搜索对象。 这些邮件应该有日期属性，所以您只需要代码就可以通过搜索对象mailItems找到最新的日期（ReceivedTime）

我建议使用该页面底部的示例—它从搜索中获取一个表对象，然后使用

Set MyTable = MySearch.GetTable  
Do Until MyTable.EndOfTable  
    Set nextRow = MyTable.GetNextRow()  
    Debug.Print nextRow("ReceivedTime")  
Loop

从那里，您可以进行比较以查找最新时间，如果您想对mailitem执行某些操作，则需要从表中获取“EntryID”列。 然后使用NameSpace对象的GetItemFromID方法获取完整项，因为该表返回只读对象

---

如果您希望，也可以对搜索应用日期筛选器，例如，如果您知道最短日期。

要查看所有文件夹，请执行以下操作： 浏览Outlook中的所有主文件夹一次，然后浏览每个主文件夹的每个子文件夹。如果您有更多的分支，那么您必须为代码“foreach Folder3 in folder2.folders”添加更多级别。此外，在if子句中，您可以测试邮件的日期，并从最新的日期到最旧的日期。设置

oMsg.display

以查看正在检查的邮件

Public Sub FORWARD_Mail_STAT_IN()
Dim Session As Outlook.NameSpace
Dim oOutLookObject As New Outlook.Application
Dim olNameSpace As NameSpace
Dim oItem As Object
Dim oMsg As Object
Dim searchkey As String

Set oOutLookObject = CreateObject("Outlook.Application")
Set oItem = oOutLookObject.CreateItem(0)
Set olNameSpace = oOutLookObject.GetNamespace("MAPI")

Set Session = Application.Session
Set Folders = Session.Folders
For Each Folder In Folders  'main folders in Outlook

        xxx = Folder.Name
           For Each Folder2 In Folder.Folders  'all the subfolders from a main folder
            yyy = Folder2.Name
             Set oFolder = olNameSpace.Folders(xxx).Folders(yyy)  'in each folder we search all the emails

              For Z = oFolder.Items.Count To 1 Step -1 ' For Z = 1 To oFolder.Items.Count
                  With oFolder.Items(Z)
                   Set oMsg = oFolder.Items(Z)

                    If Format(oMsg.SentOn, "mm/dd/yyyy") = Format(Date, "mm/dd/yyyy") And InStr(1, LCase(oMsg.Subject), searchkey, vbTextCompare) > 0 Then 
oMsg.display
                        '  insert code
                        End If
                      End With
                  Next Z
           Next Folder2
        Next Folder

---

非常感谢你的投入。我会让你知道这是怎么回事！您可能对学习递归处理文件夹的技术感兴趣，我遇到过这个函数，但不确定它是否能实现这一点。既然你已经确认了，我将尝试使用它。谢谢！我对我的答案进行了一些编辑，以详细说明我将做什么。显然，此函数是Outlook VBA函数，因此我无法在Excel VBA中使用它。您需要通过您正在创建的olApp（Outlook.Application对象）调用它，例如olApp.AdvancedSearch。非常感谢。它确实有效，但我必须去掉olApp.Session.DefaultStore.IsInstantSearchEnabled部分，因为它会给我“找不到对象”错误。你知道为什么会这样吗？