跳过已经分类的邮件

Question

现行代码：

Dim outlookapp
Dim olns As Outlook.Namespace
Dim Fldr As Outlook.MAPIFolder
Dim olMail As Object

'Dim olMail As Outlook.MailItem
Dim myTasks
Dim projIDsearch As String
Dim myrecipient As Outlook.Recipient
Dim daysAgo As Long

Set outlookapp = CreateObject("Outlook.Application")
Set olns = outlookapp.GetNamespace("MAPI")
Set myrecipient = olns.CreateRecipient("Ccbcphelpdesk")
myrecipient.Resolve

'Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("ExemptionReview")
Set Fldr = olns.GetSharedDefaultFolder(myrecipient, olFolderInbox)
' Restrict search to daysAgo
daysAgo = 0
Set myTasks = Fldr.Items.Restrict("[ReceivedTime]>'" & Format(Date - daysAgo, "DDDDD HH:NN") & "'")
projIDsearch = ActiveCell.Cells(1, 4)

For Each olMail In myTasks
    If (InStr(1, olMail.Subject, projIDsearch, vbTextCompare) > 0) Then
        olMail.Categories = "ESP"
        olMail.Save
    End If
Next
end sub

这会查找与主题中的搜索字符串相关的电子邮件，然后将其标记为ESP。我需要跳过已经分类的电子邮件。

我试过了：

If (InStr(1, olMail.Subject, projIDsearch, vbTextCompare) > 0) Then
    If olmail.categories Is nothing then 'line returns and error 424
        olMail.Categories = "ESP"
        olMail.Save
    End If
End If

如何跳过已分类的电子邮件，仅对没有类别的电子邮件进行分类？

Answer 1

https://msdn.microsoft.com/en-us/library/office/ff860423.aspx

Categories是一个String类型的属性，所以测试类似于：

If Len(olmail.Categories) = 0 Then

Answer 2

在你的And Not上使用逻辑运算符Restrict method

Set myTasks = Fldr.Items.Restrict("[ReceivedTime]>'" & Format(Date - daysAgo, "DDDDD HH:NN") & "' And Not [Categories] = 'ESP'")

并删除你的If olmail.categories Is nothing，你不检查每个olmail-它应该加快你的循环