用于处理任务更新的 Outlook 脚本

Question

我有一个三人团队，负责向 96 名销售代表发送电子邮件订单和报价。我们通过 Outlook 任务执行此操作。

在 Outlook 2007 中，我们注意到很多任务没有更新/完成。

因此，我正在通过 Outlook 规则运行一个脚本来处理所有传入的任务更新，以查看这是否有助于解决问题。

代码运行良好，但每隔几次脚本运行我就会收到 "rules in error: The operation failed"。这是我正在使用的宏：

Sub taskupdateMacro(item As Outlook.MailItem)

 Dim olkApp, olkNS, olkTaskFolder, objItem, olkTaskUpdate, olkTask
 Dim objCount
 objCount = 0

 Set olkApp = CreateObject("Outlook.Application")
 Set olkNS = olkApp.GetNamespace("MAPI")
 olkNS.Logon "Outlook"
 Set olkTaskFolder = olkNS.GetDefaultFolder(6)
 For Each objItem In olkTaskFolder.Items
     If (objItem.Class = 50 Or objItem.Class = 51 Or objItem.Class = 43) Then
        objCount = objCount + 1
        objItem.Display
        objItem.Close 1
     End If
 Next

 If objCount = 0 Then
    MsgBox "No Task Related Emails to Open"
 End If

 Set objItem = Nothing
 Set olkTaskFolder = Nothing
 Set olkTaskRequest = Nothing
 Set olkTask = Nothing
 olkNS.Logoff
 Set olkNS = Nothing
 Set olkApp = Nothing

End Sub

Answer 1

规则不可靠，但在尝试 ItemAdd 或 NewMailEx 之前，请先看看清理代码会发生什么。

Outlook 已经在运行，因此您不需要 CreateObject 也不需要 Logon。

Sub taskupdateMacro(item As mailItem)

 'Dim olkApp

 Dim olkNS As Namespace
 Dim olkTaskFolder As folder
 Dim objItem As Object

 'Dim olkTaskUpdate
 'Dim olkTask As TaskItem

 Dim objCount As Long

 objCount = 0

 'Set olkApp = CreateObject("Outlook.Application")
 'Set olkNS = olkApp.GetNamespace("MAPI")

 Set olkNS = GetNamespace("MAPI")

 'olkNS.Logon "Outlook"

 Set olkTaskFolder = olkNS.GetDefaultFolder(6)

 For Each objItem In olkTaskFolder.Items
     If (objItem.Class = 50 Or objItem.Class = 51 Or objItem.Class = 43) Then
     Debug.Print objItem.subject & " Class is: " & objItem.Class

        objCount = objCount + 1
        objItem.Display
        objItem.Close 1
     End If
 Next

 If objCount = 0 Then
    MsgBox "No Task Related Emails to Open"
 End If

 Set objItem = Nothing
 Set olkTaskFolder = Nothing

 'Set olkTaskRequest = Nothing
 'Set olkTask = Nothing
 'olkNS.Logoff

 Set olkNS = Nothing
 'Set olkApp = Nothing

End Sub