Outlook VBA永久删除共享邮箱中的旧电子邮件

时间:2017-07-26 10:06:43

标签: vba outlook outlook-vba

我遇到一个问题,我需要永久删除超过特定年龄的共享邮箱中的电子邮件。

不幸的是,AutoArchive功能不会影响共享邮箱,每次我尝试运行规则来执行此操作时,它都会失败并且不会执行任何操作。我一直不得不手动清除这个邮箱中的数百封电子邮件,这封邮件需要一个绝对的年龄(当你有超过300k的时候坐在那里......),因为它填满了我自己删除的邮件。

我非常精通Excel VBA,但我不知道Outlook如何处理事情。我一直在寻找一种方法来做到这一点,但我还没有找到任何可靠的,我可以使用的,这是很好的注释教我。

有没有其他人必须做同样的事情?我不可能是唯一一个想要这样做的人吗?

编辑: 我一直在砍掉我发现尝试实现的随机代码。我可以访问我部门内的其他6个共享邮箱。我一直在关注GetSharedDefaultFolder函数,但是当我的提交尝试运行时,它没有很好地解释并且通常是错误。我不确定它在收件人函数中的含义,因为我已经尝试了邮箱名称和地址。在这种情况下,MS在线资源不是很有用:

编辑2:

我已将我的代码编辑到下面。在这个版本中,我在行上得到一个溢出错误对于intCount = olSharedBox.Items.Count到1步-1 由于该框中有超过300k的电子邮件,我认为它现在正在寻找合适的东西,但不确定是否可以解决这个问题。是否无法从收件箱旁边显示的预先计算的数字中获取当前数字?

Sub DeleteOldSharedMail()

Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olMailItem As Outlook.MailItem
Dim objVariant As Variant
Dim lngMovedItems As Long
Dim intCount As Integer
Dim intDateDiff As Integer
Dim olSharedBox As Folder
Dim mbOwner As Outlook.Recipient


Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set mbOwner = olNS.CreateRecipient("mailbox@email.com")
Set olSharedBox = olNS.GetSharedDefaultFolder(mbOwner, olFolderInbox)

For intCount = olSharedBox.Items.Count To 1 Step -1
    Set objVariant = olSharedBox.Items.Item(intCount)
    DoEvents
    If objVariant.Class = olMail Then

         intDateDiff = DateDiff("d", objVariant.SentOn, Now)

        ' Set number of days
        If intDateDiff > 180 Then
          objVariant.Delete
          Call ClearDeletedFolder ' Working. Will change to call every 100 emails deleted after first run.

          'count the # of items moved
           lngMovedItems = lngMovedItems + 1

        ' No need to run the IF statement on the rest of the mailbox assuming the macro runs from oldest to newest.
        'Else: GoTo Marker

        End If
    End If
Next

' Display the number of items that were moved.
Marker:
MsgBox "Moved " & lngMovedItems & " messages(s)."
End Sub

1 个答案:

答案 0 :(得分:1)

您可以使用NameSpace.GetSharedDefaultFolder方法获取收件箱以删除项目。但是,如果项目位于另一个文件夹中,则需要对该邮箱具有“邮箱”访问权限,或者对特定文件夹具有写入权限。在这些情况下,您需要找到该邮箱中的文件夹,如果该邮箱也已添加到当前Outlook配置文件中。然后,您可以从NameSpace.Stores中匹配的Store对象访问文件夹(例如,通过Store.GetDefaultFolder或.GetRootFolder,然后" walk"通过Folder.Folders集合)。

无论如何,都有在Outlook对象模型中立即永久删除电子邮件的方法。但是,如果您在“已删除邮件”文件夹中再次找到它,则可以将其删除两次。

另见: How to: Delete All Items and Subfolders in the Deleted Items Folder