excel - 在指定日期范围内将 Outlook 电子邮件从最旧到最新导入 Excel

Question

我正在尝试制作一个 excel 宏，将我的 Outlook 文件夹中的电子邮件导入到指定日期范围(收到的电子邮件)的 excel 文件中。这个过程必须定期进行。因此，我需要继续在 Excel 工作表中的现有电子邮件下方添加电子邮件。
在我的工作表中 L1 包含 从日期 和单元格二级包含 迄今为止 .
我的邮箱是从排序的从旧到新 .我有 2019 年至今的电子邮件。我的第一封电子邮件来自 2019 年 8 月 27 日。
我想获取 28/08/2020 到 30/08/2020 范围内的电子邮件。单元格 L1 的日期为 28/08/2020。单元格 L2 的日期为 2020 年 8 月 30 日。
下面是我使用的代码。宏退出循环而不做任何事情。我试过单步执行代码并发现宏在第一封电子邮件后立即退出循环。
我想我在逻辑上遗漏了一些东西。
此外，与其指示用户将邮箱从最旧到最新排序，我们可以强制 VBA 这样做吗？我试过OutlookItems.Sort [ReceivedTime] , true 但收到错误“需要对象”。现在我在代码中做了一个注释。如何将其添加到此代码中？

Sub Download_Emails()


Application.ScreenUpdating = False

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim objOwner As Outlook.Recipient
Dim i As Integer
Dim olItems As Object
Dim olItem As Object
Dim LastRow As Long
Dim ToDt As Date

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

ToDt = Range("L2").Value + 1

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set objOwner = OutlookNamespace.CreateRecipient("xxxxxxxxxx.com")   'Set the Outlook mailbox name
objOwner.Resolve

'OutlookItems.Sort [ReceivedTime], true (results in error Object required)

'Allows the user to select the desired folder from which the emails are to be imported
If objOwner.Resolved Then
Set Folder = GetObject("", "Outlook.Application").GetNamespace("MAPI").PickFolder
End If

i = LastRow
LastRow = LastRow + 1


For Each OutlookMail In Folder.Items
If TypeName(OutlookMail) = "MailItem" Then

'Sets the date from which the user wants to import the emails from
If CDate(OutlookMail.ReceivedTime) < Range("L1").Value Then   'From Date
    'Do nothing
    
ElseIf CDate(OutlookMail.ReceivedTime) < ToDt Then   'To Date

'Imports email subject, received date and time, sender's name, and the email body into the excel file
Range("A1").Offset(i, 0) = OutlookMail.Subject
Range("B1").Offset(i, 0) = OutlookMail.ReceivedTime
Range("C1").Offset(i, 0) = OutlookMail.SenderName
'Range("D1").Offset(i, 0) = OutlookMail.Body
               
i = i + 1

'If the email date range is crossed, then exit the loop
Else: Exit For
End If
End If

Next OutlookMail
 
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
 
'Do not wrap text of the imported emails
Sheet1.Cells.WrapText = False
 
Application.ScreenUpdating = True

'Pop up saying the import is complete
MsgBox "Email importing is done!", vbOKOnly + vbInformation

End Sub

Answer 1

如果您第一次遇到的电子邮件日期超出了您的日期范围，您的代码将转到 Else: Exit For循环结束。
只需删除这行代码。
还有一点关于排序for each循环不保证项目的任何顺序，并且在执行代码之前对其进行排序可能不会影响循环返回的顺序。
编辑:您没有声明 OutlookItems也没有为其分配任何值 - 这就是您收到错误的原因，最佳做法是始终放置 Option Explicit在代码顶部或在设置中强制它。