根据类别将电子邮件移动到子文件夹

时间:2019-04-04 01:51:04

标签: outlook outlook-vba

我的收件箱中有一些子文件夹,可用于组织/归档电子邮件。我的文件夹结构如下:

  

收件箱

     

-0天收件箱

     

事项

     

-1。主题名称A

     

---客户

     

----收件箱

     

----已发送

     

---内部

     

----收件箱

     

----已发送

     

-2。主题名称B

     

---客户

     

----收件箱

     

----已发送

     

---内部

     

----收件箱

     

----已发送

我提交的一般流程:

1)通过规则将收到的所有电子邮件复制到“ 0dayInbox”文件夹。这是因为我要在主收件箱中保留所有电子邮件的副本。

2)我浏览0dayInbox文件夹,然后根据不同主题(例如,主题A-内部或主题A-客户)对电子邮件进行分类,或者如果它们是垃圾电子邮件,请将其标记为“不用于归档”类别。

3)我有规则将分配给类别的电子邮件移动到某些文件夹,或者如果标记为“不用于归档”,则将其永久删除。例如,如果电子邮件被分类为主题A-内部,则将其移动到

Inbox --> Matters --> 1. Topic Name A --> Internal --> Inbox folder

4)我的Outlook有一个计时器,它将每3小时在0dayInbox文件夹上运行一次规则。如果未分配任何类别,电子邮件将保留在0dayInbox文件夹中。

上面的方法工作得很好,但只要我有新主题,就必须创建新规则。我也不认为规则的执行必然是最有效的(有时我需要等待一分钟左右才能完成)。

我的代码:

在“ ThisOutlookSession”模块中:

Private Sub Application_Quit()
  If TimerID <> 0 Then Call DeactivateTimer
End Sub

Private Sub Application_Startup()
    Call ActivateTimer(180)
End Sub

在常规模块中:

Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long

Public Sub ActivateTimer(ByVal nMinutes As Long)
  nMinutes = nMinutes * 1000 * 60 
  If TimerID <> 0 Then Call DeactivateTimer
  TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer)
  If TimerID = 0 Then
    MsgBox "The timer failed to activate."
  End If
End Sub

Public Sub DeactivateTimer()
Dim lSuccess As Long
  lSuccess = KillTimer(0, TimerID)
  If lSuccess = 0 Then
    MsgBox "The timer failed to deactivate."
  Else
    TimerID = 0
  End If
End Sub

Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)

    Dim objRules As Outlook.Rules
    Dim objRule As Outlook.Rule
    Dim olFolder  As Outlook.MAPIFolder
    Dim olNamespace As Outlook.NameSpace
    Set olNamespace = Application.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox).Folders("0dayInbox")

    Set objRules = Outlook.Application.Session.DefaultStore.GetRules

    Set objRule = objRules.Item("Internal-Topic A")
    With objRule
        .Enabled = True
        .Execute ShowProgress:=True, Folder:=olFolder, IncludeSubfolders:=False
    End With

    Set objRule = objRules.Item("Client-Topic A")
    With objRule
        .Enabled = True
        .Execute ShowProgress:=True, Folder:=olFolder, IncludeSubfolders:=False
    End With

End Sub

我不想每次有新主题时都建立新规则;并更有效地完成任务。

似乎有两个替代选择:

1)保留上面的代码,但是当计时器触发例程而不是运行规则时,它将遍历0dayInbox并根据基于一系列If和Elseif的类别移动文件夹(或在“不用于归档”,则将其永久删除)。

2)删除计时器代码并在分类后移动电子邮件。

0 个答案:

没有答案