Question

我正在使用来自excel的vba在我的默认Outlook收件箱中搜索主题行上包含“每周运营报告”的电子邮件，然后转移到excel。如何修改我的代码以符合条件：如果主题行显示为“ Weekly Op's Report”，并且接收日期=今天，则复制电子邮件正文。这是我的代码如下：

Sub GetFromInbox()

Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olItms As Outlook.Items
Dim olMail As Variant
Dim i As Long

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

olItms.Sort "Subject"

i = 1

For Each olMail In olItms
    If InStr(1, olMail.Subject, "Weekly Op's Report for ") > 0 Then
        ThisWorkbook.Sheets("tester").Cells(i, 1).Value = olMail.Body
        i = i + 1

    End If
Next olMail

Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

Answer 1

您可以使用olMail对象的ReceivedTime属性来实现您的请求。请尝试以下代码：

Sub GetFromInbox()

Dim olApp As Outlook.Application
Dim olNs As Outlook.NameSpace
Dim olFldr As Outlook.MAPIFolder
Dim olItms As Outlook.Items
Dim olMail As Variant
Dim i As Long
Dim date1 As String
Dim date2 As String

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set olItms = olFldr.Items
date1 = Date
olItms.Sort "Subject"
olItms.Sort "[ReceivedTime]", True

i = 1

For Each olMail In olItms
date2 = olMail.ReceivedTime
If InStr(1, olMail.Subject, "Weekly Op's Report for ") > 0 And DateDiff("d", date1, date2) = 0 Then
    ThisWorkbook.Sheets("tester").Cells(i, 1).Value = olMail.Body
    i = i + 1

End If
Next olMail

Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

有关更多DateDiff函数，请参见How to use the DATEDIFF Function (VBA)。

如果收到Outlook主题和日期

1 个答案: