excel - VBA - 即使匹配是收件箱中的第一封电子邮件，代码也需要 5 分钟以上的时间来搜索收件箱 - 我该如何加快速度？

Question

此代码目前需要几分钟才能自行运行，即使电子邮件是收件箱中的最新电子邮件(即在匹配之前几乎不需要排序)。

Sub Info()

Application.DisplayAlerts = False

Dim [all sorts of stuff]

Set priorSaveFolder = y.Sheets([SHEET]).Range([LOOKUP])

'Find Mailbox to search for information
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set sharedemail = olNS.CreateRecipient("[MAILBOX]")
Set olfldr = olNS.GetSharedDefaultFolder(sharedemail, olFolderInbox)
Set folder = olfldr
Set myTasks = folder.Items.Restrict("[Subject]='AP Settlement'")
myTasks.Sort "[ReceivedTime]", False

'Search folder, save

For Each olMail In myTasks
    If olMail.Attachments.Count > 0 Then
        For Each objAtt In olMail.Attachments
            If InStr(objAtt.Filename, "MTTAX") Or InStr(objAtt.Filename, "mttax") Then
                objAtt.SaveAsFile priorSaveFolder & "MTTAX.html"
                Exit For
            End If
        Next objAtt
    End If
Next olMail

[MORE CODE BELOW THAT ISN'T TAKING FOREVER]

Answer 1

搜索继续为 Exit For仅应用于内部循环。Exit For再次退出外循环:

Dim foundFlag As Boolean

For Each olMail In myTasks
    If olMail.Attachments.count > 0 Then
        For Each objAtt In olMail.Attachments
            If InStr(objAtt.FileName, "MTTAX") Or InStr(objAtt.FileName, "mttax") Then
                objAtt.SaveAsFile priorSaveFolder & "MTTAX.html"
                
                foundFlag = True
                
                Exit For
                
            End If
        Next objAtt
    End If
    
    If foundFlag = True Then Exit For
    
Next olMail