OutLook 收发邮件时自动分类

    虽然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 =