Question

我使用下面提到的代码行来遍历所有电子邮件，以找到具有特定主题行的电子邮件。然而，它始终从最旧的一个开始，并且花费大量时间，因为大多数所需的邮件是最新的邮件。请告诉我以下代码的错误或建议更准确的。感谢。

`enter code here`
Dim outMailItem As Outlook.MailItem
Dim inputDate As String, subjectFilter As String
Dim saveInFolder As   String
Dim filesys, newfolder, newfolderpath
OutlookOpened = False
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set outApp = New Outlook.Application
OutlookOpened = True
End If
On Error GoTo 0

If outApp Is Nothing Then
MsgBox "Cannot start Outlook.", vbExclamation
Exit Sub
End If

Set outNs = outApp.GetNamespace("MAPI")

Set outFolder = outNs.Folders("Personal Folders").Folders("Inbox")  
'Set outFolder = outNs.PickFolder                                   
Set outItems = outFolder.Items
If Not outFolder Is Nothing Then
 outItems.Sort "[ReceivedTime]", False
 For Each outItems In outFolder.Items
    If outItems.Class = Outlook.OlObjectClass.olMail Then

        Set outMailItem = outItems
        randomdate = Format(outMailItem.SentOn, "dd/mm/yy")
        If outMailItem.Subject = subjectFilter Then

        If randomdate = inputDate1 Then

            Debug.Print outMailItem.Subject
            For Each outAttachment In outMailItem.Attachments
                    outAttachment.SaveAsFile saveInFolder & outAttachment.Filename
                Next
        End If
        End If
    End If
Next

P.S。我已经尝试了排序顺序的True和False。

Answer 1

为什么需要遍历所有项？使用Items.Find / FindNext查找Subject属性值的匹配。

set outMailItem = outItems.Find("[Subject] = '" & subjectFilter & "'")

如果您有多个匹配项，则可以使用Findf / FindNext

循环遍历它们

set outMailItem = outItems.Find("[Subject] = '" & subjectFilter & "'")
while Not (outMailItem  Is Nothing)
  'do something with outMailItem 
  set outMailItem  = outItems.FindNext
wend

使用带有降序日期的vba在outlook中循环显示电子邮件

1 个答案: