按主题自动将收到的电子邮件移动到共享邮箱中的子文件夹答案

【问题标题】：Automatically move incoming emails by subject to sub folder in a shared mailbox按主题自动将收到的电子邮件移动到共享邮箱中的子文件夹
【发布时间】：2019-12-02 22:25:28
【问题描述】：

我们在共享邮箱中整理电子邮件。每个区域都有文件夹，每个特定位置都有一个子文件夹。

我正在尝试检查传入电子邮件的主题行以将电子邮件移动到正确的文件夹。

在主题行中查找的内容类似于“%%-%%”，百分比是字母。我们有 900 多个地点，我希望不必创建 900 条规则。

Sub MoveToFolder(Item As Outlook.MailItem)

    Dim Subject As String
    Subject = Item.Subject

    Dim FolderToMoveTo As Outlook.Folder
    Set FolderToMoveTo = GetFolder("KX-BH")

    If (CheckSubject(Subject, "KX-BH")) Then
        Item.Move (FolderToMoveTo)
    End If

End Sub


Function CheckSubject(Subject As String, PatternToCheck As String)

    Dim ObjRegExp As RegExp
    Dim ObjMatch As Match

    Set ObjRegExp = New RegExp
    ObjRegExp.Pattern = PatternToCheck

    If (ObjRegExp.Text(Subject) = True) Then
        CheckSubject = True
    End If

End Function


Function GetFolder(ByVal FolderName As String) As Outlook.Folder

    Dim ObjFolder As Outlook.Folder
    Set ObjFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Folders(FolderName)
    Set GetFolder = ObjFolder

End Function

【问题讨论】：

标签： vba outlook

【解决方案1】：

您似乎对 Application 类的 NewMailEx 事件感兴趣，该事件在收件箱中收到新项目时触发。 NewMailEx 事件在新邮件到达收件箱时触发，并且在客户端规则处理发生之前。您可以使用EntryIDCollection数组中返回的Entry ID调用NameSpace.GetItemFromID方法并处理该项目。

Public WithEvents outApp As Outlook.Application

Sub Intialize_Handler()
    Set outApp = Application
End Sub

Private Sub outApp_NewMailEx(ByVal EntryIDCollection As String)
   Dim mai As Outlook.MailItem
   Set mai = Application.Session.GetItemFromID(strEntryId)

   MsgBox mai.Subject

   MoveToFolder(mai)
End Sub

【讨论】：