excel - 使用 Excel VBA 在主题和附件中查找带有关键字的 Outlook 电子邮件

Question

我正在尝试在 Outlook 中搜索主题行中带有“Blue Recruit Req Data”的最新电子邮件。
主题行中会有额外的词。
当找到一封电子邮件时，我需要验证它是否有附件。
我想将主题和接收日期存储在变量中，并将它们与存储在运行宏的 Excel 文件中的先前主题和日期进行比较。
如果主题行不匹配并且电子邮件的日期晚于最后存储在 Excel 文件中的日期，那么我想将该附件保存在一个文件夹中。
它没有找到主题中包含“Blue Recruit Req Data”的电子邮件。

Sub CheckEmail_BlueRecruit()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim olAp As Object, olns As Object, olInb As Object
    Dim olItm As Object, olAtch As Object, olMail As Object
    'Outlook Variables for email
    Dim sSubj As String, dtRecvd As String
    Dim oldSubj As String, olddtRecvd As String

    Sheets("Job Mapping").Visible = True
    Sheets("CC Mapping").Visible = True
    Sheets("Site Mapping").Visible = True
    Sheets("Historical Blue Recruit Data").Visible = True
    Sheets("Historical HRT Data").Visible = False
    Sheets("Combined Attrition Data").Visible = True

    Sheets.Add Before:=Sheets(1)

    'Designate ECP Facilities Model file as FNAME
    myPath = ThisWorkbook.Path
    MainWorkbook = ThisWorkbook.Name
    
    Range("A1").Select
    ActiveCell.FormulaR1C1 = myPath
    
    'designate file path for Attrition Files
    FacModPath = Cells(1, 1).Value
    Sheets(1).Delete

    'Get Outlook Instance
    Set olAp = GetObject(, "Outlook.application")
    Set olns = olAp.GetNamespace("MAPI")
    Set olInb = olns.GetDefaultFolder(6)
    Set olMail = olInb.Items.Restrict("[Subject] = ""*Blue Recruit Req Data*""")
    
    'Chec if there are any matching emails
    If Not (olMail Is Nothing) Then

        For Each olItm In olMail
            If myItem.Attachments.Count <> 0 Then
                dtRecvd = olItm.ReceivedTime
                sSubj = olItm.Subject
                oldSubj = Sheets("CC Mapping").Range("M2").Value
                olddtRecvd = Sheets("CC Mapping").Range("M3").Value
                If sSubj = oldSubj Or dtRecvd <= olddtRecvd Then
                    MsgBox "No new Blue Recruit data files to load."
                    Exit Sub
                Else
                    Range("M2").Select
                    ActiveCell.FormulaR1C1 = sSubj
                    Range("M3").Select
                    ActiveCell.FormulaR1C1 = dtRecvd
                    For Each myAttachment In myItem.Attachments
                        If InStr(myAttachment.DisplayName, ".xlsx") Then
                            I = I + 1
                            myAttachment.SaveAs Filename:=FacModPath & "\" & myAttachment.DisplayName
                            Exit For
                        Else
                            MsgBox "No attachment found."
                            Exit For
                        End If
                    Next
                End If
            End If
        Next
    
    Else
    
        MsgBox "No emails found."
        Exit Sub
    
    End If

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

一个单独但相关的问题。我想搜索 Outlook 存档文件夹甚至收件箱子文件夹中的电子邮件。我需要以不同的方式格式化这行代码吗？

Set olInb = olns.GetDefaultFolder(6)

Answer 1

当然，遍历文件夹中的所有项目并不是一个好主意。您需要使用 Restrict或 Find/FindNext Items 类的方法来仅获取与您的条件相对应的项目。在以下文章中阅读有关这些方法的更多信息:

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

在上面发布的代码中，我注意到以下行:

Set olMail = olInb.Items.Restrict("[Subject] = ""*Blue Recruit Req Data*""")

请注意， Restrict方法返回 Items 的实例包含与您的条件相对应的项目集合的类，而不是您想象的单个项目。例如:

Sub MoveItems()  
    Dim myNamespace As Outlook.NameSpace  
    Dim myFolder As Outlook.Folder  
    Dim myItems As Outlook.Items  
    Dim myRestrictItems As Outlook.Items  
    Dim myItem As Outlook.MailItem  

    Set myNamespace = Application.GetNamespace("MAPI")  
    Set myFolder = _  
        myNamespace.GetDefaultFolder(olFolderInbox)  
    Set myItems = myFolder.Items  
    Set myRestrictItems = myItems.Restrict("[Subject] = ""*Blue Recruit Req Data*""")  
    For i =  myRestrictItems.Count To 1 Step -1  
        myRestrictItems(i).Move myFolder.Folders("Business")  
    Next  
End Sub

另外，我会更改过滤器字符串以包含可能包含传递的子字符串的条目:

filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " LIKE '%" & wordsInSubject & " %'"

要订购元素，即从最近或最旧的元素开始，您需要使用 Sort 对集合进行排序 Items 的方法类(class):

Items.Sort("[ReceivedTime]")

最后，您还可以找到 AdvancedSearch Application 类的方法很有帮助。使用 AdvancedSearch 的主要好处Outlook中的方法是:

搜索在另一个线程中执行。您不需要手动运行另一个线程，因为 AdvancedSearch方法在后台自动运行它。

可以在任何位置(即超出某个文件夹的范围)搜索任何项目类型:邮件、约会、日历、便笺等。 Restrict和 Find/FindNext方法可以应用于特定的Items集合(参见 Outlook 中 Items 类的 Folder 属性)。

完全支持 DASL 查询(自定义属性也可用于搜索)。您可以在 Filtering 中了解更多信息。 MSDN 上的文章。为了提高搜索性能，Instant Search如果 Instant Search 可以使用关键字为商店启用(参见 IsInstantSearchEnabled 类的 Store 属性)。

您可以随时使用 Stop 停止搜索过程。 Search 的方法类(class)。

阅读有关 AdvancedSearch 的更多信息方法并在 Advanced search in Outlook programmatically: C#, VB.NET 中找到示例代码文章。