用於在目錄之間對郵件進行排序的Outlook模板規則

我有爲不同項目（例如Proj1，Proj2，Proj3，...）創建的文件夾。部門的一般慣例是發送有關特定項目的電子郵件，並在主題中列出其名稱（例如「項目1：項目已完成！」）。用於在目錄之間對郵件進行排序的Outlook模板規則

我知道我可以爲每個項目創建規則，將包含其名稱的郵件移動到項目文件夾中。但是，我需要創建與我擁有的文件夾數量一樣多的規則 - 所以它不是非常方便和最優的。

有沒有什麼辦法可以創建一個規則（一個規則）（可能與VBA代碼），將包含所有文件夾名稱的列表，從列表中搜索郵件的主題中的任何名稱，並自動將郵件移動到相應文件夾？

2015-10-07 Shurov

爲了實現正是你可以使用你想要的這個宏：

Sub RulesForFolders(m As MailItem) 
Dim fldr As Outlook.Folder 
For Each fldr In GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders 
    If m.Subject Like "*" & fldr.Name & "*" Then m.Move fldr 
Next 
Set fldr = Nothing 
End Sub

這個宏可以通過一個新的電子郵件到達被觸發，如果你添加到ThisOutlookSession模塊這些行：

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String) 
Dim o As Object 
Set o = Application.Session.GetItemFromID(EntryIDCollection) 
If TypeName(o) = "MailItem" Then RulesForFolders o 
Set o = Nothing 
End Sub

雖然，我建議你擺脫你移動你的消息的文件夾。相反，您可以將所有郵件保留在收件箱中，並使用搜索文件夾以您想要的任何順序對其進行分組。通過這種方式，您可以快速搜索所有收件箱並對其進行分類以及單獨的搜索文件夾。您也可以在不同的文件夾中複製相同的消息。如果你決定這樣做，你的宏將需要自行分配移動消息類：

Sub RulesForFolders(m As MailItem) 
Dim fldr As Outlook.Folder, str As Outlook.Store 
For Each str In Application.Session.Stores 
    For Each fldr In str.GetSearchFolders 
     If m.Subject Like "*" & fldr.Name & "*" Then 
      m.Categories = m.Categories & "," & fldr.Name 
      m.Save 
     End If 
    Next 
Next 
Set fldr = Nothing 
Set str = Nothing 
End Sub

來源

2015-10-09 01:09:01

謝謝！我在If If TypeName（o）=「MailItem」中更改了一些語句：然後MailRules或MailRules需要更改爲RulesForFolders。另外，在'If m.Subject Like「*」＆fldr.Name＆「*」Then'我已經添加了'LCase'函數來處理更一般的模板。不適合我的一件事是我有子文件夾（所有需要的項目文件夾都是子文件夾），而循環考慮到accout父文件夾。如何重新編寫循環來處理子文件夾？謝謝 – Shurov

@Shurov我看到你明白了這一點。如果您需要更系統的方法（例如，您擁有多個子文件夾級別），則可以自行創建此子通話。讓我知道你是否需要一個代碼。 –

我所需要的規則來處理子文件夾，所以我稍微修改@Vladislav安德列夫的以前的答案：

Sub RulesForFolders(m As MailItem) 
    Dim fldr As Outlook.Folder 
    For Each fldr In GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders 
     If LCase(m.Subject) Like "*" & LCase(fldr.Name) & "*" Then 
      m.Move fldr 
      Exit For 
     End If 
     For Each subFldr In fldr.Folders 
      If LCase(m.Subject) Like "*" & LCase(subFldr.Name) & "*" Then 
       m.Move subFldr 
       Exit For 
      End If 
     Next 
    Next 
    Set fldr = Nothing 
    Set subFldr = Nothing 
End Sub

來源

2015-10-12 08:47:03 Shurov

用於在目錄之間對郵件進行排序的Outlook模板規則

回答

相關問題