Application_Quit（）中的代码没有运行（Outlook）

Question

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

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

Private Sub Application_Quit() 

    On Error Resume Next 

    Call delete_LV_emails 
    Call mark_JIRA_read 
    Call empty_junk 
    Call empty_deleted 

End Sub 

，我打电话的潜艇是一个名为“清理”模块中，我知道他们都工作时，我对自己的运行。但是，只有“delete_LV_emails”子被调用。也就是说，当我关闭/重新打开Outlook时。唯一发生的事情是自动生成的电子邮件被移动到“已删除邮件”文件夹中。我无法弄清楚为什么只有一个潜艇被调用。

如果它的事项，每个潜艇的代码如下：

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 

我意识到，这是一个非常啰嗦的问题，但如果任何人有任何了解我将不胜感激。

谢谢！

-Sean

Answer 1

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

On Error Resume Next你基本上指示VBA基本上忽略错误以及代码的下一行恢复执行。

请务必记住，On Error Resume Next不以任何方式“修复”错误。它只是指示VBA继续，就好像没有错误发生一样。

查看 http://www.cpearson.com/excel/ErrorHandling.htm

Answer 2

最新版本的Outlook不调用Quit事件处理程序。他们没有通过Go，也没有收到200美元 - 他们刚刚辞职。

，您可以观看Explorer.Close和Inspector.Close事件 - 如果只有一个浏览器或检查左（如Application.Explorers.Count和Application.Inspectors.Count报道），展望为关闭。