用于在x天后删除电子邮件的VBA代码

时间:2013-03-18 17:09:45

标签: vba outlook-vba outlook-2010

我正在尝试删除收件箱中超过90天的所有电子邮件。我无法使用自动存档,因为它已在我的办公室被禁用。我有一些代码似乎没有删除超过90天的每封邮件。我认为这个问题可能与我的循环有关。我在Exchange 2010中使用Outlook 2010。

Private Sub RemoveEmail90()

Dim olSession As Outlook.Application, olNamespace As NameSpace
Dim olInbox As Outlook.MAPIFolder
Dim i As Integer
Set olSession = New Outlook.Application
Set olNamespace = olSession.GetNamespace("MAPI")
Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox)
Set Delete_Items = olInbox.Items

For i = Delete_Items.Count To 1 Step -1
    If TypeName(Delete_Items.Item(i)) = "MailItem" Then
            If DateDiff("d",now, Delete_Items.Item(i).ReceivedTime) > 90 Then Delete_Items.Item(i).Delete
    End If
Next

Set olSession = Nothing
Set olNamespace = Nothing
Set olInbox = Nothing
End Sub

1 个答案:

答案 0 :(得分:0)

我能够通过调整代码来修复它。现在代码运行得很好。我改变了" m"在第13行到" d"现在它正在删除所有旧电子邮件。上面更新的代码。

If DateDiff("d",now, Delete_Items.Item(i).ReceivedTime) > 90 Then Delete_Items.Item(i).Delete