OutLook 收发邮件时自动分类

来源：互联网发布：淘宝药房旗舰店靠谱吗编辑：程序博客网时间：2024/06/05 03:36

虽然OutLook 有自带的邮件规则，但如果对方发送邮件时是通过代表的话，就不起作用了。笔者每天要收100多封邮件，无奈之下又祭出了利器——宏。相信也有网友每天和我一样，受着相同问题的折磨，所以特地在此和大家一同分享。

以下为实现代码

Private Sub Application_NewMail()   Dim myNameSpace As Outlook.NameSpace      Dim inFolder As Outlook.MAPIFolder      Dim o As Object      Dim mi As MailItem      ' 设定移动目标目录   Dim DestFolder As Outlook.MAPIFolder      '字典   Set d = CreateObject("Scripting.Dictionary")      '得到Outlook的命名空间   Set myNameSpace = Outlook.Application.GetNamespace("MAPI")      '得到inbox目录   Set inFolder = myNameSpace.GetDefaultFolder(Outlook.olFolderInbox)         '遍历inbox里的邮件   For Each o In inFolder.Items        '如果class等于43，表示这是一封邮件（另如果class等于53，表示这是一个日历）        If o.Class = 43 Then            Set mi = o            '取发件人的名称              x = mi.SenderEmailAddress            y = mi.SentOnBehalfOfName            '移动到对应文件夹              '----------------------------------------------------------            '                             Project            '----------------------------------------------------------            If (x = "zhangsan@ttni.com.cn") Or (y = "zhangsan") Then                Set DestFolder = inFolder.Folders.Item("project")                mi.Move DestFolder            End If                        '----------------------------------------------------------            '                             会社              '----------------------------------------------------------            If (x = "lisi@ttni.com.cn") Or (y = "lisi") Then                Set DestFolder = inFolder.Folders.Item("会社").Folders.Item("lisi")                mi.Move DestFolder            End If                    End If    NextEnd Sub