用于在选定电子邮件上分配使用类别的 Outlook VBA

Question

我正在寻找一种在 Outlook 类别的帮助下将工作（电子邮件）分配给我的团队成员的方法，但是考虑到我每天有 2000 封电子邮件，我必须手动执行此操作，这也是一项艰巨的任务，我正在尝试实现以下目标

1) 为每个团队成员分配 3 封电子邮件 2) 只分配选定的电子邮件而不是整个邮箱 3) 按最旧到最新电子邮件的顺序分配。 4) 分配按照以下要求完成，即

如果选择了 10 封电子邮件，则分布应该看起来像电子邮件 ie 1,2,3 给代理 1，电子邮件 ie 4,5,6 给代理 2，电子邮件 ie 7,8,9 给代理 3，电子邮件 ie 10 给代理 3代理 4 和循环在这里停止。

Sub EmailCategories()
Dim strCat As String
Dim olmail As MailItem
'If Item.Class = olmail Then
'For i = 0 To 2

For Each olmail In Outlook.Application.ActiveExplorer.Selection
'olmail.Categories = "Agent - 1"

Select Case i
Case 0
olmail.Categories = "Agent - 1"
Case 1
olmail.Categories = "Agent - 2"
Case 2
olmail.Categories = "Agent - 3"
Case 3
olmail.Categories = "Agent - 4"
Case 4
olmail.Categories = "Agent - 5"
Case 5
olmail.Categories = "Agent - 6"
End Select

'Item.Categories = mailMsg
olmail.Item.Save
Err.Clear

Next
'End If
i = i + 3
Debug.Print i
If i = 5 Then
i = 0
End If
End Sub

Answer 1

我终于破解了解决方案，所以分享如下，谢谢。

Sub category_assigment()
Dim oOutlook As Object: Dim oExplorer As Object
Dim i As Long: Set oOutlook = CreateObject("Outlook.Application")
Dim objSelection As Outlook.Selection
Dim Result As Integer
Set objSelection = Application.ActiveExplorer.Selection

Set oExplorer = oOutlook.ActiveExplorer: Dim oSelection As Object
Set oSelection = oExplorer.Selection
Dim oCategory As String
'For i = 1 To oSelection.Count
On Error Resume Next
For i = oSelection.Count To 1 Step -1
If oSelection.Item(i).Categories = "" Then
For x = 0 To 15
If x = 0 Then
oCategory = "Agent 1"
ElseIf x = 3 Then
oCategory = "Agent 2"
ElseIf x = 6 Then
oCategory = "Agent 3"
ElseIf x = 9 Then
oCategory = "Agent 4"
ElseIf x = 12 Then
oCategory = "Agent 5"
ElseIf x = 15 Then
oCategory = "Agent 6"
Else: GoTo Line01
End If
For y = 0 To 2
If oSelection.Item(i - x - y).Categories = "" Then
oSelection.Item(i - x - y).Categories = oCategory
oSelection.Item(i - x - y).Save
End If
Next
Line01:
Next
End If
Next i

Result = MsgBox("Total Emails Assigned : " & _
            objSelection.Count, vbInformation, "Selected Items")

End Sub