VBA 使用多标准从 Outlook 下载电子邮件附件

Question

我正在尝试创建一个代码，从 excel 中的某些输入（日期、主题、电子邮件正文、邮箱、文件夹导航和导出到）中获取下载的某些电子邮件的附件。

我的问题是，即使代码获取了正确的邮箱和文件夹，并将附件下载到我想要的文件夹，它也没有获取日期、主题和电子邮件正文。整个目标是从日期开始的电子邮件中下载附件，电子邮件主题包含一些单词，电子邮件正文包含某些单词，但是我得到的是邮箱中所有电子邮件的附件。

这是我的代码（我尝试将 & 更改为 AND，但它甚至无法下载）：

 Sub download_attachment()

 Dim olApp As Outlook.Application
 Dim olNS As Outlook.Namespace
 Dim olFolder As Outlook.MAPIFolder
 Dim olItem As Object
 Dim mailitem As Outlook.mailitem
 Dim olAtt As Outlook.Attachment 

 Dim Folder_Navigation As String
 Dim folders() As String
 Dim folderIndx As Long
 Dim dateFormat
 dateFormat = Format(Now, "dd.mm.yyyy")

 Set olApp = New Outlook.Application
 Set olNS = olApp.GetNamespace("MAPI")
 Set olFolder = olNS.folders([Sheet1].[Mailbox_Name].Text)
 Folder_Navigation = [Sheet1].[Folder_Navigation].Value
 folders = Split(Folder_Navigation, ";")

For folderIndx = LBound(folders) To UBound(folders)
Debug.Print folders(folderIndx)
 Set olFolder = olFolder.folders(folders(folderIndx))
 Next folderIndx

 For Each olItem In olFolder.Items
    If olItem.Class = olMail Then
        Set mailitem = olItem   

    Debug.Print mailitem.Subject
    Debug.Print mailitem.ReceivedTime

        If mailitem.ReceivedTime > [Sheet1].[Date].Value & _
          InStr(mailitem.Subject, [Sheet1].[Subject].Value) <> 0 & _
          InStr(mailitem.Body, [Sheet1].[Email_Body].Value) <> 0 Then
            For Each olAtt In mailitem.Attachments
                olAtt.SaveAsFile [Sheet1].[Export_To].Text & "\" & olAtt.Filename
            Next olAtt
        End If
    End If
 Next olItem

 Set olFolder = Nothing
 Set olNS = Nothing
 Set olApp = Nothing

 End Sub
```

Answer 1

首先，如代码所示，无需遍历文件夹中的所有项目：

For Each olItem In olFolder.Items
    If olItem.Class = olMail Then

相反，Outlook 对象模型提供Items 类的Find/FindNext 或Restrict 方法。因此，您将能够仅迭代与您的搜索条件相对应的项目。在以下文章中阅读有关这些方法的更多信息：

• How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
• How To: Use Restrict method to retrieve Outlook mail items from a folder

例如，以下搜索条件可用于获取带有附件和包含关键字的主题的项目：

Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & _
                   Chr(34) & " Like '%keyword%' AND " & _
                   Chr(34) & "urn:schemas:httpmail:hasattachment" & _
                   Chr(34) & "=1"

更多示例请查看VBA Outlook: Find specific attachment and save under different name 和Check for the senderEmailAddress。

您还可能会发现Application 类的AdvancedSearch 方法很有帮助。请参阅Advanced search in Outlook programmatically: C#, VB.NET 了解更多信息。