代码优化 – 循环/searchExcel中的电子邮件

我有一个macros，通过收件箱中的项目循环，并通过ReportProvider返回这些发送（保存在Table1中的详细信息）。 在这一点上，macros运行良好，但在我看来，这是缓慢的 – 大约需要2分钟循环6000封电子邮件。

有没有办法做得更快？

这是我的代码：

Option Explicit Sub getOutlookData() Dim oApp As Outlook.Application Dim oMail As Object Dim oFolder, oSubFolder As Outlook.Folder Dim oSubject, oSender, oTime, oSubFolderID As String Dim oAttachment As Outlook.Attachment Dim i, j, k, counter As Integer Set oApp = New Outlook.Application Application.ScreenUpdating = False Range("Table1").AutoFilter If Range("Table1").Rows.Count > 1 Then Range("Table1").Rows.Delete ' clear the table i = 1 '========================= Get Number of Emails ========================= counter = 0 For Each oFolder In Outlook.Session.Folders If oFolder.Name = "[e-mail]" Then For Each oSubFolder In oFolder.Folders If oSubFolder.Name = "Inbox" Then oSubFolderID = oSubFolder.EntryID counter = counter + oSubFolder.Items.Count End If Next oSubFolder End If Next oFolder '========================= /Get Number of Emails ========================= '========================= Get Emails sent by provider ========================= Set oSubFolder = Outlook.Session.GetFolderFromID(oSubFolderID) For Each oMail In oSubFolder.Items statusView.Show ' show status dialog Call Status(oMail.Parent.Parent.Name & "/" & oMail.Parent.Name, oMail.Subject, "Checked " & k & "/" & counter) 'update status dialog k = k + 1 If oMail.Class = 43 Then If oMail.SenderName = "ReportRrovider" Then With Range("Table1") statusView.Label4 = "Found " & j ' update status dialog .Cells(i, 1).Value = oMail.Parent.Parent.Name & "/" & oMail.Parent.Name .Cells(i, 2).Value = oMail.SenderName .Cells(i, 3).Value = oMail.Subject .Cells(i, 4).Value = CDate(oMail.SentOn) If oMail.attachments.Count > 0 Then .Cells(i, 5).Value = oMail.attachments.Item(1).Size If oMail.attachments.Count > 0 Then .Cells(i, 6).Value = oMail.attachments(1).DisplayName .Cells(i, 7).Value = oMail.EntryID .Cells(i, 8).Value = oSubFolder.EntryID .Cells(i, 9).Value = CDate(oMail.ReceivedTime) .Cells(i, 10).Formula = "=VLOOKUP([@Attachment],MappingTable[#All],2,0)" .Cells(i, 10).Copy .Cells(i, 10).PasteSpecial xlValues i = i + 1 j = j + 1 End With End If End If Next oMail Unload statusView ' hide status dialog Application.ScreenUpdating = True 'Call downloadAttachments End Sub Sub status(Optional ByVal caption1 As String, Optional ByVal caption2 As String, Optional ByVal caption3 As String, Optional ByVal caption4 As String) If caption1 <> "" Then statusView.label1.Caption = caption1 If caption2 <> "" Then statusView.label2.Caption = caption2 If caption3 <> "" Then statusView.label3.Caption = caption3 If caption4 <> "" Then statusView.Label4.Caption = caption4 End Sub 

如果你能发表一个方法/技巧来解释它是如何工作的，或者为什么它是更好的解决scheme，而不仅仅是代码答案，我将不胜感激。 学习这些东西对我来说很重要:)

最好的祝福

Wujaszkun

Answer 1

永远不要遍历文件夹中的所有项目。 使用Items.Find/FindNext或Items.Restrict 。 你想要的查询是"[SenderName] = 'ReportRrovider'" 。

另外，在循环的每一步中，计算oMail.Parent.Parent.Name & "/" & oMail.Parent.Name绝对没有任何理由：对于给定文件夹中的所有项目，该值将是相同的。 在进入循环之前计算它

Answer 2

让我们从更新的想法开始：

 Dim oSubject as string, oSender as string , oTime as string, oSubFolderID As String Dim oAttachment As Outlook.Attachment Dim i as long, j as long, k as long, counter As long 

这样你就明确地把它们声明为给定的types，否则它们是变体，而且这是昂贵的。 此外，在VBA中不要使用Integer，它比较小，比较慢。