Outlook VBA指定文件夹下符合条件邮件自动转发问题求助

问题原因 #

原代码仅绑定了默认收件箱的ItemAdd事件，未对目标子文件夹Folder1配置事件监听，因此邮件进入该文件夹时不会触发转发逻辑。如果你的需求是仅处理Folder1内的邮件，原代码同时监听默认收件箱的逻辑也不符合规则。

调整后完整代码 #

' 声明Folder1的事件监听变量
Public WithEvents objFolder1 As Outlook.Folder
Public WithEvents objFolder1Items As Outlook.Items

Private Sub Application_Startup()
    Dim objInbox As Outlook.Folder
    ' 适配多账户场景，先定位到ownmail@gmail.com账户的收件箱
    Dim objAccount As Outlook.Account
    For Each objAccount In Outlook.Application.Session.Accounts
        If objAccount.DisplayName = "ownmail@gmail.com" Then
            Set objInbox = objAccount.GetDefaultFolder(olFolderInbox)
            Exit For
        End If
    Next
    ' 如果是单账户默认就是ownmail@gmail.com，可以用下面这行替换上面的循环逻辑
    ' Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    
    ' 绑定Folder1的事件
    Set objFolder1 = objInbox.Folders("Folder1")
    Set objFolder1Items = objFolder1.Items
End Sub

Private Sub objFolder1Items_ItemAdd(ByVal Item As Object)
    Dim objMail As Outlook.MailItem
    Dim objForward As Outlook.MailItem

    If TypeOf Item Is MailItem Then
       Set objMail = Item

       ' 匹配发件人和正文关键字规则
       If (objMail.SenderEmailAddress = "sourcemail@gmail.com") And InStr(Item.Body, "ABCDE") > 0 Then

           Set objForward = objMail.Forward
           ' 自定义转发邮件配置
           With objForward
                .Subject = "test subject"
                .HTMLBody = "<HTML><BODY>test body</BODY></HTML>" & objForward.HTMLBody
                .Recipients.Add ("recepient1@gmail.com")
                .Recipients.Add("recepient2@gmail.com").Type = olCC
                .Recipients.ResolveAll
                .Importance = olImportanceHigh
                .Send
           End With
       End If
    End If 
End Sub

关键说明 #

• 代码默认适配多账户场景，可准确匹配ownmail@gmail.com账户下的Folder1文件夹，若该账户为Outlook默认账户，可注释掉账户循环逻辑，直接使用GetDefaultFolder获取收件箱
• 若需要同时监听默认收件箱和Folder1两个路径的邮件，只需保留原代码的默认收件箱监听变量和对应ItemAdd事件逻辑即可
• 修改完成后需重启Outlook，或在VBA编辑器中手动运行Application_Startup过程即可生效

内容的提问来源于stack exchange，提问作者Jerry Yeremia