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報道），展望爲關閉。