（在线等...)VB调用outlook删除指定日期以前的邮件，遇到有回执邮件，速度很慢。。

shibotao

功能：自动清除收件箱和已删除邮件中15天以前收到的邮件。遇到问题如下：

1。收件箱中含有邮件回执，（即OUTLOOK自动回复的邮件）则Set objMailItem = objMAPIFolder.Items(J)时会出错，这里只能用一个错误处理程序。请问，如何判断邮件是回执？

2。收件箱中没有邮件时，速度很慢！（断点发现程序执行End Sub一句时要等几十秒)该段代码有错吗？有其它办法可以优化吗？ 代码如下：

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) 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 objApp.Quit 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

7dZ1M9sO.rar (24.19 KB, 下载次数: 87)

2004-7-11 16:21 上传

点击文件名下载附件
（在线等...)VB调用outlook删除指定日期以前的邮件，遇到有回执邮件，速度很慢。。。

loadhigh

shibota你好！

不好意思，刚刚才看到你的问题。

你的第1个问题是可以这样解决的，将“ Dim objMailItem As Outlook.MailItem” 改成“ Dim objMailItem As object”

第2个问题，可以在代码中加入判断inbox是否有邮件的if...then代码.

如将这句代码 if objMAPIFolder.Items.Count =0 then exit sub 加在代码 "Set objMAPIFolder = objNameSpace.GetDefaultFolder(FolderType:=olFolderInbox)"之后。这样当inbox内无邮件时，代码就不再向下执行了。当然你也可以在exit sub 之前可以加入撤销你定义的对象的代码，这样程序就更完备，也符合程序的规范。