时间戳

首页 > 解决方案 > 来自特定文件夹的自动转发电子邮件

vba - 来自特定文件夹的自动转发电子邮件

问题描述

我想在 vba 中创建具有条件的自动转发电子邮件：

  1. 只有来自“sourcemail@gmail.com”的邮件并且正文中有“ABCDE”

  2. 仅来自收件箱 \ownmail@gmail.com\Inbox\Folder1 下特定文件夹的邮件

如果邮件进入“收件箱”，则条件 1 没有问题，但如果邮件进入“文件夹 1”，则条件 2 不会自动转发。

我的代码是这样的：

Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items

Private Sub Application_Startup()
    Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Set objInboxItems = objInbox.Items
End Sub

Private Sub objInboxItems_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 it is a specific new email
       If (objMail.SenderEmailAddress = "sourcemail@gmail.com") And InStr(Item.Body, "ABCDE") > 0 Then

           Set objForward = objMail.Forward
           'Customize the forward subject, body and recipients
           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

标签： vbaoutlook

解决方案

我相信您只检查直接进入收件箱的邮件。要检查进入Folder1的邮件是否被转发，我认为您必须执行与收件箱类似的操作，例如以下代码：

' Inbox: Folder1
Public WithEvents InboxFolder1 As Outlook.Items

' Put this line in Sub Application_Startup. Correct the path if it's not this.
Set InboxFolder1 = objInbox.Folders.Item("ownmail@gmail.com").Folders.Item("Inbox").Folders.Item("Folder1").Items

' Create this procedure
Private Sub InboxFolder1_ItemAdd(ByVal Item As Object)
    ' Put your code in here
    Debug.Print Item.Subject
End Sub

推荐阅读