Question

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

此最新消息可以位于Inbox的子文件夹中的Inbox，Sent Items，Inbox的子子文件夹（任何位置）。

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

我有以下代码，

- ＆GT;在收件箱中搜索“searchKey”

- ＆GT;如果在收件箱文件夹中找到它，则回复

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

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

这段代码可能会让人感到困惑和冗长，所以如果您需要澄清，请告诉我。

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

Answer 1

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

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

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

从那里，你可以进行比较以找到最新的时间，如果你想对mailitem做点什么，你需要获得＆＃34; EntryID＆＃34;表中的列。然后使用NameSpace对象的GetItemFromID方法获取完整项，因为该表返回只读对象。

如果您知道最低日期，也可以根据需要对搜索应用日期过滤器。

Answer 2

要浏览所有文件夹，请执行以下操作：单击Outlook中的所有主文件夹，然后对每个主文件夹浏览每个子文件夹。如果你有更多的分支，那么猜测你必须为代码“为folder2.folders中的每个Folder3”添加更多级别。同样在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

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

2 个答案: