如何从最近的电子邮件开始将电子邮件从 Outlook 拉到 Excel？答案

【问题标题】：How to pull emails from Outlook to Excel starting with the most recent email?如何从最近的电子邮件开始将电子邮件从 Outlook 拉到 Excel？
【发布时间】：2021-07-21 08:19:40
【问题描述】：

我的代码考虑了电子邮件的日期与我的阈值。例如，如果我将阈值设置为 2020 年 4 月 1 日，它将把从 2020 年 4 月 1 日到今天的所有电子邮件。

我的代码很慢，因为它从我最旧的电子邮件开始。如何使用最近的电子邮件开始索引？

我使用 items.sort "CreationDate" 在网上找到的代码，true 不起作用，因为它完全删除了日期。

我已经简化了代码：

Sub dateextract()
    Dim OutlookApp As Outlook.Application
    Dim Outlooknamespace As Namespace
    Dim folder As MAPIFolder
    Dim subfolder As MAPIFolder
    Dim OutlookMail As Variant
    Dim i As Long
    Dim dates As Date
    Dim time As Date
    Dim sender As String   
    
    Set OutlookApp = New Outlook.Application
    Set Outlooknamespace = OutlookApp.GetNamespace("MAPI")
    Set folder = Outlooknamespace.GetDefaultFolder(olFolderInbox)
    dates = Cells(1, 2).Value
    i = 1
    
    For Each OutlookMail In folder.Items    
        time = OutlookMail.ReceivedTime
        If time >= dates Then

       '........

【问题讨论】：

为什么您的收件箱中有如此多的电子邮件？当然这需要时间。我怀疑收件箱是一个可以使用 SELECT 的数据库。因此 Outlook 需要遍历您拥挤的收件箱中的所有电子邮件。解决方案？清除收件箱并重新开始。另一种方法是导出收件箱并在本地处理所有电子邮件。提示：一天结束时，收件箱是空的！您是否将实体邮件信封存放在实体邮箱中？不！
这对我没有帮助。为了我的目的，我需要我的整个收件箱都是可搜索的。这个想法是，如果我可以从最新的电子邮件开始，我可以添加一个 if 语句，如果它超出阈值则结束 for 循环

标签： excel vba outlook

【解决方案1】：

限制和排序是通常的解决方案。

Sub dateextract()

    ' Early binding
    '  Reference Outlook XX.X Object Library
    Dim outlookApp As Outlook.Application
    
    Dim folder As folder
    
    Dim outlookItem As Object
    
    Dim i As Long
    Dim dates As Date
    
    Dim fldrItems As Items
    
    Dim strFilter As String
    Dim resItems As Items
    
    Set outlookApp = New Outlook.Application
    Set folder = Session.GetDefaultFolder(olFolderInbox)
    
    ' Unknown value and unknown format
    'dates = Cells(1, 2).Value
    
    ' dates = Format("2020-01-04", "yyyy-mm-dd")    '?
    dates = Format("2021-01-04", "yyyy-mm-dd")
    
    Set fldrItems = folder.Items
    Debug.Print "fldrItems.Count: " & fldrItems.Count
    
    strFilter = "[CreationTime] > '" & dates & "'"
    Debug.Print strFilter
    
    Set resItems = fldrItems.Restrict(strFilter)
    Debug.Print "resItems.Count: " & resItems.Count
    
    ' Sort collections in memory, not items in folder
    resItems.Sort "[CreationTime]", True
    
    For i = 1 To resItems.Count
        If resItems(i).Class = olMail Then
            Set outlookItem = resItems(i)
            Debug.Print i & ") " & outlookItem.CreationTime & ": " & outlookItem.Subject
        End If
    Next
    
End Sub

【讨论】：