代码优化 - 循环通过 Outlook 子文件夹将电子邮件导入 Excel答案

【问题标题】：Code Optimization - Looping through Outlook subfolders to import emails into Excel代码优化 - 循环通过 Outlook 子文件夹将电子邮件导入 Excel
【发布时间】：2018-10-04 03:41:43
【问题描述】：

我有一个宏，它遍历 2 个 Outlook 子文件夹并将一些电子邮件信息（发件人、主题、日期）导入 Excel 工作表。子文件夹中的电子邮件并不多（如果您搜索整个月，总共可能有 100-200 封电子邮件）。但是，宏似乎花费了过多的时间来运行（约 3 分钟）。

关于让宏运行得更快有什么建议吗？

仅供参考 - vba 新手

Sub OptimizeCode_Begin()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
ActiveSheet.DisplayPageBreaks = False

End Sub

_____

Sub OptimizeCode_End()

ActiveSheet.DisplayPageBreaks = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

______

Sub GetFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Long
Dim j As Long


Call OptimizeCode_Begin

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Individual Lot Inspections")
Set Folder2 = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Construction Site Inspections")

i = 1

For Each OutlookMail In Folder.Items
    If OutlookMail.ReceivedTime >= Range("From_date").Value Then
        Range("eMail_subject").Offset(i, 0).Value = OutlookMail.Subject
        Range("eMail_date").Offset(i, 0).Value = OutlookMail.ReceivedTime
        Range("eMail_sender").Offset(i, 0).Value = OutlookMail.SenderName
        ' Range("eMail_text").Offset(i, 0).Value = OutlookMail.Body

        i = i + 1
    End If
Next OutlookMail

j = i + 1

For Each OutlookMail In Folder2.Items
    If OutlookMail.ReceivedTime >= Range("From_date").Value Then
        Range("eMail_subject").Offset(j, 0).Value = OutlookMail.Subject
        Range("eMail_date").Offset(j, 0).Value = OutlookMail.ReceivedTime
        Range("eMail_sender").Offset(j, 0).Value = OutlookMail.SenderName

        j = j + 1
    End If
Next OutlookMail

Set Folder = Nothing
Set Folder2 = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

Call OptimizeCode_End

结束子

【问题讨论】：

考虑观察Code Review的/help/how-to-ask和/help/on-topic页面；在 Stack Overflow 上，代码审查通常是题外话。

标签： excel vba optimization outlook

【解决方案1】：

首先，永远不要遍历文件夹中的所有项目。将Items.Find/FindNext 或Items.Restrict 与[ReceivedTime] > '2018-09-01' 之类的查询一起使用。

其次（如果你确实使用了循环），不要在循环中不断地计算永不改变的表达式。在您的情况下，它们是Range("From_date").Value、Range("eMail_subject")、Range("eMail_date")、Range("eMail_sender")。在开始循环之前计算这些表达式，将返回值存储在变量中，并在循环中使用它们。

【讨论】：

完美，Items.Restrict 让它在合理的时间内运行。