筛选基于主题的Outlook电子邮件，然后下载附件

我正在尝试执行以下操作：

1. search未读的电子邮件
2. 打开具有特定关键字的那些
3. 从电子邮件下载附件（如果我也可以通过附件进行筛选，那将是非常好的）
4. 将电子邮件标为已读。

这是我正在与之合作。

Sub DownloadAttachmentFirstUnreadEmail() Dim oOlAp As Object, oOlns As Object, oOlInb As Object Dim oOlItm As Object, oOlAtch As Object Dim strFilter As String '~~> New File Name for the attachment Dim NewFileName As String NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-" '~~> Get Outlook instance Set oOlAp = GetObject(, "Outlook.application") Set oOlns = oOlAp.GetNamespace("MAPI") Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox) '~~> Check if there are any actual unread emails If oOlInb.Items.Restrict("[UnRead] = True").count = 0 Then MsgBox "NO Unread Email In Inbox" Exit Sub End If '~~> Extract the attachment from the 1st unread email For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True") 'The above loop begins to read everything that is unread. 'This is the part that gets tricky 'Here we need to begin filtering subject headline 'The line below defines what we are filtering strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%sketch%'" If filteredItems.count = 0 Then Debug.Print "No emails found" Found = False Else '~~> Check if the email actually has an attachment If oOlItm.Attachments.count <> 0 Then For Each oOlAtch In oOlItm.Attachments '~~> Download the attachment oOlAtch.SaveAsFile NewFileName & oOlAtch.FileName Exit For Next Else MsgBox "The First item doesn't have an attachment" End If End If '~~> Mark 1st unread email as read oOlItm.UnRead = False DoEvents oOlItm.Save Exit For Next End Sub 

Answer 1

如果你在第一个filter中的每个未读项目上使用Instr，那么你的代码的结构就可能起作用。

第二个filter更有效率。

 Sub FilerBySubjectUnreadEmail() Dim oOlAp As Object Dim oOlns As Object Dim oOlInb As Object Dim oOlItm As Object Dim oOlAtch As Object Dim strFilter As String Dim objUnreadItems As Items Dim filteredItems As Items Dim i As Long '~~> Get Outlook instance On Error Resume Next ' You can use this as there is a purpose Set oOlAp = GetObject(, "Outlook.application") On Error GoTo 0 ' One line from On Error Resume Next. If say five or more lines you are fired. If oOlAp Is Nothing Then Set oOlAp = CreateObject("Outlook.application") Set oOlns = oOlAp.GetNamespace("MAPI") Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox) Set objUnreadItems = oOlInb.Items.Restrict("[UnRead] = True") '~~> Check if there are unread emails If objUnreadItems.count = 0 Then MsgBox "NO Unread Email In Inbox" Exit Sub End If ' Change sketch to what you are looking for strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%sketch%'" Set filteredItems = objUnreadItems.Restrict(strFilter) If filteredItems.count = 0 Then Debug.Print "No emails found with applicable subject" Exit Sub Else For i = filteredItems.count To 1 Step -1 'Debug.Print i & " - " & filteredItems.count '~~> Check if the email actually has an attachment Set oOlItm = filteredItems(i) If oOlItm.Attachments.count <> 0 Then For Each oOlAtch In oOlItm.Attachments Debug.Print oOlItm.Subject Debug.Print oOlAtch.DisplayName Next '~~> Mark email as read filteredItems(i).UnRead = False DoEvents ' Safest to save the item ' in case it is needed ' but not necessary with Read/Unread ' oOlItm.Save Else MsgBox oOlItm.Subject & " doesn't have an attachment." End If Next End If ExitRoutine: Set oOlAp = Nothing Set oOlns = Nothing Set oOlInb = Nothing Set oOlItm = Nothing Set oOlAtch = Nothing Set objUnreadItems = Nothing Set filteredItems = Nothing End Sub