时间戳

首页 > 解决方案 > 收到电子邮件时运行的 Outlook 脚本仅在我将新邮件传输给自己时才有效

vba - 收到电子邮件时运行的 Outlook 脚本仅在我将新邮件传输给自己时才有效

问题描述

我编写了一个代码，它将接收特定文件夹中的传入电子邮件（首先创建一个规则以便将邮件移动到文件夹，然后启动脚本）。

问题是该规则有效（它将邮件移动到文件夹），但脚本无效。

问题是当我收到新邮件并将其传输给自己时（我的电子邮件也在规则的接收者中），脚本正常工作。

这是我认为可能是错误的代码的开头。

Sub Script(item As Outlook.MailItem) 


Dim strMailID As String
Dim objMail As Outlook.MailItem
Dim objNamespace As Outlook.NameSpace

strMailID = item.EntryID
Set objNamespace = Application.GetNamespace("MAPI")
Set objMail = objNamespace.GetItemFromID(strMailID)
Dim objpf As MAPIFolder

If objMail.MessageClass = "IPM.Note" Then

任何帮助，将不胜感激

标签： vbaoutlook

解决方案

您需要将事件侦听器添加到默认的本地收件箱，它适用于 Outlook 2016。

此代码将向默认本地收件箱添加一个事件侦听器。将对收到的电子邮件采取行动。您需要在下面的代码中添加您需要的操作：

                Private WithEvents Items As Outlook.Items 
                Private Sub Application_Startup() 
                Dim olApp As Outlook.Application 
                Dim objNS As Outlook.NameSpace 
                Set olApp = Outlook.Application 
                Set objNS = olApp.GetNamespace("MAPI") 
                ' default local Inbox
                Set Items = objNS.GetDefaultFolder(olFolderInbox).Items 
                End Sub
                Private Sub Items_ItemAdd(ByVal item As Object) 

                On Error Goto ErrorHandler 
                 Dim Msg As Outlook.MailItem 
                 If TypeName(item) = "MailItem" Then
                Set Msg = item 
                ' ******************
                ' do something here
                ' ******************
                End If
                ProgramExit: 
                  Exit Sub
                ErrorHandler: 
                MsgBox Err.Number & " - " & Err.Description 
                Resume ProgramExit 
                End Sub

在 ThisOutlookSession 模块中粘贴代码后，您必须重新启动 Outlook。

推荐阅读