VBA自动化邮件归类与自定义功能：智能分文件夹与快捷操作

Public WithEvents myOlItems As Outlook.Items
Public WithEvents mySelection As Explorer

Public Sub Application_Startup()

   ' Reference the items in the Inbox. Because myOlItems is declared
   ' "WithEvents" the ItemAdd event will fire below.
   Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
   Set mySelection = Outlook.ActiveExplorer
   'For Each Item In myOlItems
       'Set mainsubject = Item.UserProperties.Add("mainsubject", olText)
       'mainsubject.Value = Item.Subject
   'Next Item
   
   addNewMenuBar
   
End Sub
Function arrangeMail(ByVal mail As MailItem)
    Dim subFolderExist As Boolean
    Dim subfolder As Folder
    subFolderExist = False
    For Each subfolder In myOlItems.Parent.Folders
        If subfolder.Description = mail.SenderEmailAddress Then
            subFolderExist = True
            Exit For
        End If
    Next subfolder
    
    If subFolderExist = False Then
        On Error Resume Next

        Set subfolder = myOlItems.Parent.Folders.Add(mail.SenderName)
        If Err.Number = 0 Then
            subfolder.Description = mail.SenderEmailAddress
        End If
    End If
    If Err.Number > 0 Then
        Err.Clear
    Else
        mail.Move subfolder
    End If
End Function
Sub reArrangeMail()
    'For Each mail In myOlItems
    For i = myOlItems.Count To 1 Step -1
        On Error Resume Next
        'arrangeMail mail
        arrangeMail myOlItems.Item(i)
        If Err.Number > 0 Then
            Err.Clear
        End If
    'Next mail
    Next i
End Sub
Sub recoverAllMail()
    For Each subfolder In myOlItems.Parent.Folders
        For Each mail In subfolder.Items
            mail.Move Outlook.Session.GetDefaultFolder(olFolderInbox)
        Next mail
        If subfolder.Items.Count = 0 Then
            subfolder.Delete