此代码目前需要几分钟才能自行运行,即使电子邮件是收件箱中的最新电子邮件(即在匹配之前几乎不需要排序)。
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]
最佳答案
搜索继续为 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
关于excel - VBA - 即使匹配是收件箱中的第一封电子邮件,代码也需要 5 分钟以上的时间来搜索收件箱 - 我该如何加快速度?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/66538198/