[英]Get email from Outlook to Excel specified by received date
I am creating a macro to get email by subject and received date in our team shared box. 我正在创建一个宏来按主题收到电子邮件,并在我们的团队共享框中收到日期。
I use for loop to check all email in mailbox but it takes forever because my statement checks 1000+ mails. 我使用for循环检查邮箱中的所有电子邮件,但它需要永远,因为我的语句检查1000多封邮件。
How can I get email by specific date? 如何按特定日期收到电子邮件? Let's say I need email 12/1/2017 to 12/30/2017.
假设我需要电子邮件12/1/2017到12/30/2017。
The key is using Restrict method but I don't know how I can use it. 关键是使用Restrict方法,但我不知道如何使用它。
Sub GetFromOutlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Dim olShareName As Outlook.Recipient
Set olShareName = OutlookNamespace.CreateRecipient("sharemailbox@example.ca")
Set Folder = OutlookNamespace.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders("sharebox subfolder").Folders("sharebox subfolder2")
i = 1
For Each OutlookMail In Folder.Items
If ((Range("From_Date").Value <= OutlookMail.ReceivedTime) And _
(OutlookMail.ReceivedTime <= Range("To_Date").Value)) And _
OutlookMail.Sender = "sender@example.com" Then
Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
i = i + 1
End If
Next OutlookMail
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
End Sub
I assume the code I have to fix is: 我假设我必须解决的代码是:
<For Each OutlookMail In Folder.Items>
How can I make statement using Restrict Method? 如何使用Restrict方法声明?
You could probably use the GetTable
instead of a loop which has to process each email (or item) one by one. 您可以使用
GetTable
而不是循环,它必须逐个处理每个电子邮件(或项目)。 GetTable
will allow you to apply a filter on the content of the folder which should operate much faster. GetTable
将允许您对文件夹的内容应用过滤器,该过滤器应该运行得更快。
For more details and an example, you can check the MSDN article on the Folder.GetTable Method for Outlook . 有关更多详细信息和示例,您可以查看有关Outlook的Folder.GetTable方法的MSDN文章 。
And for the specific filter that you are trying to apply, I would try: 对于您尝试应用的特定过滤器,我会尝试:
"([ReceivedTime]>=12/1/17) AND ([ReceivedTime]<=12/30/17)"
You can create a collection of items restricted by date like this. 您可以像这样创建受日期限制的项目集合。
Option Explicit
Private Sub EmailInTimePeriod()
Dim oOlInb As Folder
Dim oOlItm As Object
Dim oOlResults As Object
Dim i As Long
Dim sFilterLower As String
Dim sFilterUpper As String
Dim sFilter As String
Dim dStart As Date
Dim dEnd As Date
Set oOlInb = Session.GetDefaultFolder(olFolderInbox)
' https://msdn.microsoft.com/en-us/library/office/ff869597.aspx
' 12/1/2017 to 12/30/2017
'dStart = "2017/12/01"
'dEnd = "2017/12/30"
' 1/12/2018 to 1/15/2018
dStart = "2018/01/12"
dEnd = "2018/01/16"
' Lower Bound of the range
sFilterLower = "[ReceivedTime]>'" & Format(dStart, "DDDDD HH:NN") & "'"
Debug.Print vbCr & "sFilterLower: " & sFilterLower
' *** temporary demo lines
' Restrict the items in the folder
Set oOlResults = oOlInb.Items.Restrict(sFilterLower)
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
Next i
End If
' *** temporary demo lines
' Upper Bound of the range
sFilterUpper = "[ReceivedTime]<'" & Format(dEnd, "DDDDD HH:NN") & "'"
Debug.Print vbCr & "sFilterUpper: " & sFilterUpper
' *** temporary demo lines
' Restrict the Lower Bound result
Set oOlResults = oOlResults.Restrict(sFilterUpper)
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
Next i
End If
' *** temporary demo lines
' combine the filters
sFilter = sFilterLower & " AND " & sFilterUpper
Debug.Print vbCr & "sFilter: " & sFilter
Set oOlResults = oOlInb.Items.Restrict(sFilter)
Debug.Print oOlResults.count & " items."
If oOlResults.count > 0 Then
For i = 1 To oOlResults.count
Set oOlItm = oOlResults(i)
Debug.Print oOlItm.ReceivedTime & " - " & oOlItm.subject
Next i
End If
ExitRoutine:
Set oOlInb = Nothing
Set oOlResults = Nothing
Set oOlItm = Nothing
Debug.Print "Done."
End Sub
Note the code is set up to be used in Outlook. 请注意,代码设置为在Outlook中使用。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.