Question

下面的代码将根据在单元格Worksheets("Checklist Form").Range("B5"))中输入的文本生成一封回复电子邮件。

此回复电子邮件具有所有收件人，自定义的正文，主题，并且一切运行正常。除了我通过测试意识到，它将捕获包含文本主题的最旧电子邮件或包含主题中文本的最旧电子邮件。关键是，代码似乎从收件箱中最旧线程的最旧电子邮件中复制了收件人，然后回复了同一线程中的最新电子邮件。

例如，如果工作表（清单B5）包含短语“ Kawhi Leonard”，则生成的回复电子邮件将回复最旧的电子邮件线程，但会在该线程中回复最新的电子邮件。奇怪的是，它将在收件箱中包含该主题的最旧线程中接收最旧电子邮件的收件人。

这是一个问题，因为我收到许多电子邮件，其中包含某些相同的关键字或主题。是否有一种解决方案，可以使代码捕获电子邮件主题中的最新文本。或者更好的解决方案可以选择捕获最新的解决方案。或者，也可以抓取主题确切的电子邮件，而不是主题中最古老的电子邮件。

Sub Display()

    Dim olApp As Outlook.Application
    Dim olNs As Namespace
    Dim Fldr As MAPIFolder
    Dim olMail As Variant
    Dim i As Integer
    Dim IsExecuted As Boolean

    Signature = Environ("appdata") & "\Microsoft\Signatures\"

    If Dir(Signature, vbDirectory) <> vbNullString Then
        Signature = Signature & Dir$(Signature & "*.htm")
    Else
        Signature = ""
    End If

    Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).ReadAll

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

    IsExecuted = False

    For Each olMail In Fldr.Items
        If InStr(olMail.Subject, Worksheets("Checklist Form").Range("B5")) <> 0 Then
            If Not IsExecuted Then

                With olMail.ReplyAll
                    .HTMLBody = "<p style='font-family:calibri;font-size:14.5'>" & _
                    "Hi    Everyone," & "<p style='font-family:calibri;font-size:14.5'>" & _
                    Worksheets("Checklist Form").Range("B4") & "Regards," & "</p><br>" & _
                    Signature & .HTMLBody

                    .Display
                End With

                IsExecuted = True

            End If
        End If
    Next olMail

End Sub

Answer 1

首先，切勿循环浏览文件夹中的所有项目-使用Items.Find/FindNext或Items.Restrict。在特定情况下，先呼叫Items.Sort，然后再呼叫Items.Find-您只需要一个ingle项。

第二，您需要首先对集合进行排序-在Items.Sort上调用ReceivedTime。

第三，您正在循环的每个步骤上调用Worksheets("Checklist Form").Range("B5")。这是极其低效的。

我的头顶上

set items = Fldr.Items
items.Sort "ReceivedTime", true
strSubject = Worksheets("Checklist Form").Range("B5")
set olMail = items.Find(" @SQL=Subject LIKE '" & strSubject & "'")

生成的回复电子邮件正在捕获包含主题文本的最早的电子邮件

1 个答案: