跳过已经分类的邮件

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是一个字符串类型的属性，所以使用以下内容进行测试：

If Len(olmail.Categories) = 0 Then

Answer 2

在您的And Not上使用逻辑运算符https://msdn.microsoft.com/en-us/library/office/ff869597.aspx

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

以这种方式删除If olmail.categories Is nothing --不检查每个olmail- -它应该会加快循环速度。