当主题包含

时间:2015-07-07 19:18:15

标签: vba outlook outlook-vba outlook-2013

我正在使用下面的代码。它有时有效。我的意思是我可以运行测试电子邮件并且它会做它应该做的事情,但有时我会得到错误:到目前为止我得到的两个错误是:“操作失败。无法找到对象。”并且“即时搜索未在商店中启用”。它似乎是随机的。我的问题是如何增强代码以确保它运行而不会出现这些错误???我有编程的代码每分钟开始。谢谢

Option Explicit

Sub MoveItems()

Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolderWA As Outlook.Folder
Dim myDestFolderOR As Outlook.Folder
Dim myDestFolderID As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItemWA As Object
Dim myItemOR As Object
Dim myItemID As Object
Dim strFilter1 As String
Dim strFilter2 As String
Dim strFilter3 As String
Dim RestrictItems As Outlook.Items
Dim Mail As Outlook.MailItem

On Error GoTo ErrHandler

Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.Folders("Subpayables Invoices").Folders("Inbox")
Set myItems = myInbox.Items

Set myDestFolderWA = myInbox.Folders("WA")
Set myDestFolderOR = myInbox.Folders("OR")
Set myDestFolderID = myInbox.Folders("ID")


strFilter1 = "@SQL=" & Chr(34) _
& "urn:schemas:httpmail:subject" & Chr(34) _
& " ci_phrasematch 'washington'"

strFilter2 = "@SQL=" & Chr(34) _
& "urn:schemas:httpmail:subject" & Chr(34) _
& " ci_phrasematch 'oregon'"

strFilter3 = "@SQL=" & Chr(34) _
& "urn:schemas:httpmail:subject" & Chr(34) _
& " ci_phrasematch 'idaho'"


Set RestrictItems = myItems.Restrict(strFilter1)
Set myItemWA = RestrictItems.GetFirst

Set RestrictItems = myItems.Restrict(strFilter2)
Set myItemOR = RestrictItems.GetFirst

Set RestrictItems = myItems.Restrict(strFilter3)
Set myItemID = RestrictItems.GetFirst

While TypeName(myItemWA) <> "Nothing"
myItemWA.Move myDestFolderWA
Set myItemWA = RestrictItems.GetNext
Wend

While TypeName(myItemOR) <> "Nothing"
myItemOR.Move myDestFolderOR
Set myItemOR = RestrictItems.GetNext
Wend

While TypeName(myItemID) <> "Nothing"
myItemID.Move myDestFolderID
Set myItemID = RestrictItems.GetNext
Wend
Exit Sub

ErrHandler:
MsgBox Err & ": " & Error(Err)

End Sub

1 个答案:

答案 0 :(得分:1)

  

我没有收到任何错误,但它没有做我想做的事情

您是否尝试调试代码并查看其中发生了什么?你有任何错误吗?

当一次将大量项目添加到文件夹(超过16个)时,不会运行Items类的ItemAdd事件。这是一个众所周知的问题。是这样的吗?

您可以考虑处理在收件箱中收到新项目时触发的Application类的NewMailEx事件。这是MSDN所说的:

当新邮件到达收件箱时以及客户端规则处理发生之前,将触发NewMailEx事件。您可以使用EntryIDCollection数组中返回的条目ID来调用NameSpace.GetItemFromID方法并处理该项。请谨慎使用此方法,以尽量减少对Outlook性能的影响。但是,根据客户端计算机上的设置,在新邮件到达收件箱后,垃圾邮件过滤和将新邮件从收件箱移动到另一个文件夹的客户端规则等过程可能会异步发生。您不应该假设在这些事件发生后,您将始终获得收件箱中项目数量的一项增加。