Question

我需要在电子表格中搜索VBA中指定的范围内的多个电子邮件标题。然后，我需要使用双向查找将SentOn时间粘贴到Excel中。

我只能在当前日期执行此操作，因为当我在当前日期之前输入日期时，双向查找会粘贴今天电子邮件的SentOn日期。这让我觉得我搞砸了搜索Outlook。这是我正在使用的（截断的）代码：

Dim filterStr As String
filterStr = "urn:schemas:httpmail:subject = '" & EmailName & "' AND urn:schemas:httpmail:date >= '" & TDateUTC & "' AND urn:schemas:httpmail:date <= '" & TDateUTCEOD & "' "

For Each OutputType In ThisWorkbook.Worksheets("Static Data").Range("F:F")
    If OutputType.value = "Email" Then
        ProcessName = OutputType.Offset(0, -5).value
        EmailName = OutputType.Offset(0, 2).value

    On Error Resume Next
        If Not (TargetInbox.Items.AdvancedSearch(TargetInbox, filterStr, False, "criteria") Is Nothing) Then

        SLA_Completion_Tracker_FileName.Activate
        MatchFormula1 = WorksheetFunction.Match(CLng(CDate(TDate)), ActiveSheet.Range("1:1"), 0)
        MatchFormula2 = WorksheetFunction.Match(ProcessName, ActiveSheet.Range("A:A"), 0)

        EmailTime = TargetInbox.Items.Item(EmailName).SentOn
        If Not EmailTime >= TDate And EmailTime <= TDateEOD Then EmailTime = ""

        SLA_Completion_Tracker_FileName.Activate
        Set IndexFormula = WorksheetFunction.Index(ActiveSheet.Range("A1:FA60"), MatchFormula2, MatchFormula1)

        IndexFormula.value = Format(EmailTime, "ddddd ttttt")

End If

这目前适用于今天的日期。但是，当我将其设置为搜索上一个日期时，我将其替换为：

EmailTime = TargetInbox.Items.Item(EmailName).SentOn
If Not EmailTime >= TDate And EmailTime <= TDateEOD Then EmailTime = ""

有了这个：

EmailTime = TargetInbox.Items.AdvancedSearch(TargetInbox, filterStr, False, "criteria").Item(EmailName).SentOn

什么都没有出现。我意识到这是因为我没有正确使用AdvancedSearch功能，所以有人可以帮助我吗？如何正确使用它来完成此任务？

由于

编辑：我一直在尝试查找，使用此代码：

EmailName = OutputType.Offset(0, 2).value
Dim sFilter As String
sFilter = "[Subject] = """ & EmailName & """ AND [SentOn] >= '" & Format(TDate, "ddddd h:nn AMPM") & "' AND [SentOn] <= '" & Format(TDateEOD, "ddddd h:nn AMPM") & "'"
FoundMail = TargetInbox.Items.Find(sFilter)
FoundTime = FoundMail.SentOn

但这也没有奏效。

Answer 1

AdvancedSearch是异步的，您需要等待它完成。为什么不使用MAPIFolder.Items.Find/FindNext或Items.Restrict？

Answer 2

OP在这里找到了我的问题。

以下是我最终要做的事情，万一有人偶然发现：

Dim myolApp As Outlook.Application
Dim objNS As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Dim ProcessName As String
Dim EmailName As String

Set myolApp = CreateObject("Outlook.Application")
Set objNS = myolApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders('your value here)
Set TargetInbox = objFolder.Folders('your value here)

Dim oItms As Outlook.Items
Dim oItm As Outlook.MailItem
Set oItms = TargetInbox.Items
Dim sFilter As String
Dim EmailTime As String

    sFilter = "[Subject] = """ & EmailName & """ AND [SentOn] >= '" & Format(TDate, "ddddd h:nn AMPM") & "' AND [SentOn] <= '" & Format(TDateEOD, "ddddd h:nn AMPM") & "'"
    Set oItm = oItms.Find(sFilter)
    EmailTime = oItm.SentOn

最终变得非常简单。

根据主题和指定日期范围获取电子邮件的SentOn日期，以便复制到Excel

2 个答案: