代碼優化 - 從Excel中循環搜索電子郵件

Question

我有一個宏，它循環顯示我的收件箱中的項目，並通過ReportProvider返回這些發送（保存Table1中的詳細信息）。在這一點上，宏運行良好，但在我看來這很慢 - 大約需要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 = "wujaszkun@company-where-i-work.com" 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 

我會感激，如果你可以張貼在它是如何工作的方法/與解釋伎倆或爲什麼是更好的解決方案，而不僅僅是代碼的答案。對我來說，學習這些東西:)

問候

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 

這樣，你聲明它們明確給定類型，否則它們是變體，而且這很昂貴。此外，不要在VBA中使用Integer，它比小而慢要慢。