コードの最適化 - ループバック/ Excelからの電子メールの検索

Question

私は受信トレイのアイテムをループし、ReportProviderによってこれらの送信を返すマクロを持っています（詳細はTable1に保存されています）。この時点でマクロは正常に動作しますが、私の意見では遅いです.6000個の電子メールをループするには約2分かかります。

これを行う方法はありますか？

は、ここに私のコードです：

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 

あなたが指定した型に明示的に宣言し、この方法は、さもなければそれらは変種であり、これは高価です。さらに、IntegerをVBAで使用しないでください。IntegerはVBAよりも小さく、遅くなります。