Application_Quit() 而非运行中的代码（Outlook）

Question

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

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

Private Sub Application_Quit()

    On Error Resume Next

    Call delete_LV_emails
    Call mark_JIRA_read
    Call empty_junk
    Call empty_deleted

End Sub

我调用的 subs 在一个名为 "Cleanup" 的模块中，我知道当我运行它们自己时它们都可以工作。但是，只有 "delete_LV_emails" sub 被调用。也就是我close/re-open展望的时候。唯一发生的事情是自动生成的电子邮件被移动到 "Deleted Items" 文件夹。我不明白为什么只有一个潜艇被调用。

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

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 不调用退出事件处理程序。他们没有通过围棋，也没有收到 200 美元 - 他们就退出了。

您可以观看 Explorer.Close 和 Inspector.Close 事件 - 如果只剩下一个 Explorer 或 Inspector（由 Application.Explorers.Count 和 Application.Inspectors.Count 报告），Outlook 是关闭。

Answer 2

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

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

请务必记住 On Error Resume Next 绝不是 "fix" 错误。它只是指示 VBA 继续，就好像没有发生错误一样。

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

Application_Quit() 而非运行中的代码（Outlook）

Code in Application_Quit() not Running (Outlook)

vba

email

outlook

outlook-2010

Application_Quit() 而非 运行 中的代码（Outlook）

Code in Application_Quit() not Running (Outlook)

vba

email

outlook

outlook-2010

Application_Quit() 而非运行中的代码（Outlook）