背景

Question

背景

我希望 Outlook 2010 自动移动电子邮件会存放到按此人姓名指定的文件夹中。例如：

1. 点击规则
2. 点击管理规则和警报
3. 单击“新建规则”
4. 选择“将某人的邮件移动到文件夹”
5. 点击下一步

显示以下对话框：

问题

下一部分通常如下所示：

1. 点击people or public group
2. 选择所需的人
3. 点击specified
4. 选择所需文件夹

问题

您将如何自动化这些有问题的手动任务？以下是我想要创建的新规则的逻辑：

1. 收到新消息。
2. 提取发件人的姓名。
3. 如果不存在则在收件箱下创建新文件夹
4. 将新邮件移动到分配给该人姓名的文件夹中

我认为这需要一个 VBA 宏。

相关链接

• http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/A_420-Extending-Outlook-Rules-via-Scripting.html
• http://msdn.microsoft.com/en-us/library/office/ee814735.aspx
• http://msdn.microsoft.com/en-us/library/office/ee814736.aspx
• https://stackoverflow.com/questions/11263483/how-do-i-trigger-a-macro-to-run-after-a-new-mail-is-received-in-outlook
• http://en.kioskea.net/faq/6174-outlook-a-macro-to-create-folders
• http://blogs.iis.net/robert_mcmurray/archive/2010/02/25/outlook-macros-part-1-moving-emails-into-personal-folders.aspx

更新 #1

该代码可能类似于：

Public WithEvents myOlApp As Outlook.Application

Sub Initialize_handler()
    Set myOlApp = CreateObject("Outlook.Application")
End Sub

Private Sub myOlApp_NewMail()
    Dim myInbox As Outlook.MAPIFolder
    Dim myItem As Outlook.MailItem

    Set myInbox = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set mySenderName = myItem.SenderName

    On Error GoTo ErrorHandler
    Set myDestinationFolder = myInbox.Folders.Add(mySenderName, olFolderInbox)

    Set myItems = myInbox.Items
    Set myItem = myItems.Find("[SenderName] = " & mySenderName)
    myItem.Move myDestinationFolder

ErrorHandler:
    Resume Next
End Sub

更新 #2

代码拆分如下​​：

发送了一条测试消息，什么都没发生。关于在收到新消息时实际触发消息的说明有些不详细（例如，没有提到ThisOutlookSession如何使用它）。

谢谢。

Answer 1

这个常见问题在这里得到解答。

https://web.archive.org/web/20131024034054/http://www.jpsoftwaretech.com/automatically-triage-emails-by-sender-name/

使用 ItemAdd 执行 Newmail（现在的 NewMailEx）所要执行的操作。

在 ThisOutlookSession 模块中

Private WithEvents Items As Outlook.Items
 
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
 
  ' set object reference to default Inbox
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
' fires when new item added to default Inbox
' (per Application_Startup)
 
  On Error GoTo ErrorHandler
 
  Dim Msg As Outlook.MailItem
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim targetFolder As Outlook.MAPIFolder
  Dim senderName As String
 
  ' don't do anything for non-Mailitems
  If TypeName(item) <> "MailItem" Then GoTo ProgramExit
 
  Set Msg = item
 
  ' move received email to target folder based on sender name
  senderName = Msg.senderName
 
  If CheckForFolder(senderName) = False Then  ' Folder doesn't exist
    Set targetFolder = CreateSubFolder(senderName)
  Else
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set targetFolder = _
    objNS.GetDefaultFolder(olFolderInbox).Folders(senderName)
  End If
 
  Msg.Move targetFolder
 
ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

Function CheckForFolder(strFolder As String) As Boolean
' looks for subfolder of specified folder, returns TRUE if folder exists.
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
Dim FolderToCheck As Outlook.MAPIFolder
 
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)
 
' try to set an object reference to specified folder
On Error Resume Next
Set FolderToCheck = olInbox.Folders(strFolder)
On Error Goto 0
 
If Not FolderTocheck Is Nothing Then
  CheckForFolder = True
End If
 
ExitProc:
Set FolderToCheck = Nothing
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function

Function CreateSubFolder(strFolder As String) As Outlook.MAPIFolder
' assumes folder doesn't exist, so only call if calling sub knows that
' the folder doesn't exist; returns a folder object to calling sub
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInbox As Outlook.MAPIFolder
 
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olInbox = olNS.GetDefaultFolder(olFolderInbox)
 
Set CreateSubFolder = olInbox.Folders.Add(strFolder)
 
ExitProc:
Set olInbox = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Function

Answer 2

我会完全忘记使用规则，而是制作一个附加到NewMail 事件这将创建一个文件夹（使用Folders.Add 方法）基于SenderName 属性，然后将其与 MailItem 的移动方法。