Question

我在Outlook应用程序中添加了一些VBA代码，以便在关闭程序时运行一些清理工作。具体来说，我删除了我的测试环境在工作中自动生成的任何通知电子邮件。

然后我尝试清空我的垃圾文件夹，将特定文件夹中的电子邮件标记为已读，然后永久删除“已删除邮件”文件夹中的所有项目。这是代码：

Private Sub Application_Quit()

    On Error Resume Next

    Call delete_LV_emails
    Call mark_JIRA_read
    Call empty_junk
    Call empty_deleted

End Sub

我正在调用的子组件位于名为“Cleanup”的模块中，我知道当我自己运行它们时它们都能正常工作。但是，只调用“delete_LV_emails”子。也就是说，当我关闭/重新开启前景时。唯一发生的事情是自动生成的电子邮件被移动到“已删除邮件”文件夹。我无法弄清楚为什么只有一个潜艇被召唤。

如果重要，每个潜艇的代码如下：

Sub delete_LV_emails()

    On Error Resume Next

    Dim olNS As Outlook.NameSpace
    Dim olFolder As Outlook.Folder
    Dim olItem As Object
    Dim arrKeys(0 To 1) As String

    Set olNS = Application.GetNamespace("MAPI")                                
    Set olFolder = olNS.GetDefaultFolder(olFolderInbox)                

    arrKeys(0) = "LabVIEW Error"                                                   
    arrKeys(1) = "Test Complete"

    iItemCount = olFolder.Items.Count
    sDate = Split(Str(Now), " ")(0)

    For iItemInd = iItemCount To 1 Step -1
        Set olItem = olFolder.Items(iItemInd)

        If Not Split(Str(olItem.CreationTime), " ")(0) = sDate Then GoTo NEXTITEM

    iKeyInd = 0

    While Not iKeyInd > 1
        If InStr(olItem.Subject, arrKeys(iKeyInd)) Then olItem.Delete

        iKeyInd = iKeyInd + 1
    Wend

NEXTITEM:
    Next

    Set olNS = Nothing
    Set olFolder = Nothing
    Set olItem = Nothing

End Sub

Sub empty_deleted()

    On Error Resume Next

    Dim olNS As Outlook.NameSpace
    Dim olFolder As Outlook.Folder
    Dim olItem As Object

    Set olNS = Application.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderDeletedItems)

    iItemCount = olFolder.Items.Count

    For iItemInd = iItemCount To 1 Step -1
        Set olItem = olFolder.Items(iItemInd)
        olItem.Delete
    Next

    Set olNS = Nothing
    Set olFolder = Nothing
    Set olItem = Nothing

End Sub

Sub empty_junk()

    On Error Resume Next

    Dim olNS As Outlook.NameSpace
    Dim olFolder As Outlook.Folder
    Dim olItem As Object

    Set olNS = Application.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderJunk)

    iItemCount = olFolder.Items.Count

    For iItemInd = iItemCount To 1 Step -1
        Set olItem = olFolder.Items(iItemInd)
        olItem.Delete
    Next

    Set olNS = Nothing
    Set olFolder = Nothing
    Set olItem = Nothing

End Sub

Sub mark_JIRA_read()

    On Error Resume Next

    Dim olNS As Outlook.NameSpace
    Dim olFolder As Outlook.Folder
    Dim olItem As Object

    Set olNS = Application.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderInbox).Folders("Jira")

    iItemCount = olFolder.Items.Count

    For iItemInd = iItemCount To 1 Step -1
        Set olItem = olFolder.Items(iItemInd)
        If olItem.UnRead Then olItem.UnRead = False
    Next

    Set olNS = Nothing
    Set olFolder = Nothing
    Set olItem = Nothing

End Sub

我意识到这是一个非常冗长的问题，但如果有人有任何见解我会非常感激。

Answer 1

最新版本的Outlook不会调用Quit事件处理程序。他们没有通过Go而且没有收取200美元 - 他们只是放弃了。

您可以观看Explorer.Close和Inspector.Close事件 - 如果只剩下一个资源管理器或检查器（由Application.Explorers.Count和Application.Inspectors.Count报告），则Outlook正在关闭。

Answer 2

从代码中删除 On Error Resume Next ，然后再次运行

On Error Resume Next你基本上是在指示VBA基本上忽略错误并继续执行下一行代码。

非常重要的是要记住On Error Resume Next不以任何方式＆＃34;修复＆＃34;错误。它只是指示VBA继续，就像没有发生错误一样。

查看更多信息 http://www.cpearson.com/excel/ErrorHandling.htm

Application_Quit（）中的代码未运行（Outlook）

2 个答案: