OUTLOOK中删除邮件后，在退出该过程时特别慢，这是为什么？（在线等。。。）

Question

源码如下：功能:删除收件箱中15天以前的邮件.并清空已删除邮件Private Sub DelInbox()
    Dim objApp As Outlook.Application
    Dim objNameSpace As Outlook.NameSpace
    Dim objMAPIFolder As Outlook.MAPIFolder
    Dim objMailItem As Outlook.MailItem
    Dim MailCounter As Integer
    Dim totalNumber As Integer
    Dim thisDay As Date, sTemp As String, sTemp2 As String
    On Error GoTo err1
    thisDay = CDate(Now) - 15         '清除接收时间在15天以前的邮件
    Set objApp = New Outlook.Application
    Set objNameSpace = objApp.GetNamespace(Type:="MAPI")
    Set objMAPIFolder = objNameSpace.GetDefaultFolder(FolderType:=olFolderInbox)
    Open "d:\mail\delmaillist.txt" For Output As #1
    sTemp = Date & "/" & Time & "系统自动删除了接收时间在:[" & thisDay & "]以前的邮件!"
    Print #1, sTemp
    Print #1, "[第/共]/接收时间/发件人/主 题"
    Print #1, "========================================="
    totalNumber = objMAPIFolder.Items.Count
    Dim I As Integer, J As Integer '因为每次删除邮件时, objMAPIFolder.Items的序号自动为1所以用了I,J两个变量!
    J = 1
    If totalNumber >= 1 Then
    For I = 1 To totalNumber       ' 清除收件箱中邮件!
'        DoEvents
        Set objMailItem = objMAPIFolder.Items(J)   '如果收件箱中是[邮件回执]则程序会弹出一个错误,编号是13类型不匹配.只好用错误处理.
        If objMailItem.ReceivedTime <= thisDay And objMailItem.UnRead = False Then
            sTemp = "[" & I & "/" & totalNumber & "]/" & objMailItem.ReceivedTime & "/" & objMailItem.SenderName & "/" & objMailItem.Subject
            Print #1, sTemp
            sTemp = "正在删除[收件箱]中邮件(" & "接收日期为:[" & thisDay & "]前的邮件!)...[第" & I & "封/共" & totalNumber & "封] "
            lblStatus.Caption = sTemp
            objMailItem.Close olDiscard
            MailCounter = MailCounter + 1
            objMailItem.Delete
        Else
            J = J + 1
            lblStatus.Caption = "正在处理" & J & "接收日期为:[" & thisDay & "]前的邮件..."
        End If
    Next
    End If
    sTemp = "[收件箱]中:共删除了" & MailCounter & "封邮件!"
    Print #1, sTemp
    Print #1, "========================================="
    
    '************************************************************************
    MailCounter = 0
    Set objMAPIFolder = objNameSpace.GetDefaultFolder(FolderType:=olFolderDeletedItems)
    totalNumber = objMAPIFolder.Items.Count
    J = 1
    If totalNumber >= 1 Then
    For I = 1 To totalNumber       ' 清除已删除邮件中邮件!
'        DoEvents
        Set objMailItem = objMAPIFolder.Items(J)
       If objMailItem.ReceivedTime <= thisDay And objMailItem.UnRead = False Then
            sTemp2 = "[" & I & "/" & totalNumber & "]/" & objMailItem.ReceivedTime & "/" & objMailItem.SenderName & "/" & objMailItem.Subject
            Print #1, sTemp2
            sTemp2 = "正在删除[已删除邮件]中邮件(" & "接收日期为:[" & thisDay & "]前的邮件!)...[第" & I & "封/共" & totalNumber & "封] "
            lblStatus.Caption = sTemp2
            objMailItem.Close olDiscard
            MailCounter = MailCounter + 1
            objMailItem.Delete
        Else
            J = J + 1
            lblStatus.Caption = "正在处理" & J & "接收日期为:[" & thisDay & "]前的邮件..."
        End If
    Next
    End If
    sTemp2 = "[已删除邮件]中:共删除了" & MailCounter & "封邮件!"
    Print #1, sTemp2
    Print #1, "========================================="
    Close #1
    '************************************************************************
    
    lblStatus.Caption = sTemp & sTemp2
'    Set objMailItem = Nothing
'    Set objMAPIFolder = Nothing
'    Set objNameSpace = Nothing
'    Set objApp = Nothing
'    lblStatus_DblClick
    On Error GoTo 0
Exit Sub
err1:
    If Err.Number = 13 Then J = J + 1: Resume
    Resume Next
End Sub'在执行最后一句exit sub 时要1分钟，可能是在退出是御载对象。请各位指点!