我编写了一个代码,该代码将在特定文件夹中接收传入的电子邮件(首先创建一条规则,以便将邮件移至该文件夹,然后启动脚本)。
问题在于规则有效(将邮件移至文件夹),但脚本无效。
问题是,当我收到新邮件并将其发送给自己时(我的电子邮件也在规则的收件人中),该脚本可以正常工作。
这是我认为可能是错误的代码的开头。
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
任何帮助将不胜感激
答案 0 :(得分:0)
您需要将事件侦听器添加到默认的本地收件箱,它与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。