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

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

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

并以If olmail.categories Is nothing的方式移除你不会检查每个olmail - 并且它应该加快你的循环

跳过已经分类的邮件

2 个答案: