时间戳

首页 > 解决方案 > 使用 Excel VBA 在主题和附件中查找带有关键字的 Outlook 电子邮件

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

问题描述

我正在尝试在 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)

标签： excelvbaoutlook

解决方案

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

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

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：

Items.Sort("[ReceivedTime]")

最后，您可能还会发现AdvancedSearchApplication 类的方法很有帮助。AdvancedSearch在 Outlook 中使用该方法的主要好处是：

  • 搜索在另一个线程中执行。您不需要手动运行另一个线程，因为该AdvancedSearch方法会在后台自动运行它。
  • 可以在任何位置（即超出某个文件夹的范围）搜索任何项目类型：邮件、约会、日历、便笺等。和Restrict/方法可以应用于特定的集合（参见 Outlook 中类的Find属性）。FindNextItemsItemsFolder
  • 完全支持 DASL 查询（自定义属性也可用于搜索）。您可以在 MSDN中的过滤文章中阅读有关此内容的更多信息。为了提高搜索性能，如果为商店启用了Instant Search关键字，则可以使用关键字（参见类的属性）。Instant SearchIsInstantSearchEnabledStore
  • Stop您可以使用类的方法随时停止搜索过程Search。

阅读有关该AdvancedSearch方法的更多信息并在 Outlook 中的高级搜索中以编程方式查找示例代码：C#、VB.NET文章。

推荐阅读