是否使用VBA永久删除Outlook中的邮件？

我正在寻找一种使用VBA代码从Outlook 2000中永久删除邮件的方法。我希望这样做，而不必执行第二个循环来清空已删除的项目

从本质上说，我正在寻找一种与单击消息并点击SHIFT+DELETE的UI方法等效的代码

---

有这样的事情吗？

尝试先移动它，然后删除它（在2000年的一些补丁上可以使用），或者使用RDO或CDO为您完成这项工作（您必须安装它们）

CDO方式

Set objCDOSession = CreateObject("MAPI.Session")
objCDOSession.Logon "", "", False, False
Set objMail = objCDOSession.GetMessage(objItem.EntryID, objItem.Parent.StoreID)
objMail.Delete

您也可以在删除邮件之前先标记该邮件，然后在“已删除邮件”文件夹中循环，并在第二次调用“删除”时找到该邮件的数据。使用Userproperty标记它

objMail.UserProperties.Add "Deleted", olText
objMail.Save
objMail.Delete

在已删除的项目中循环查找该userprop

 Set objDeletedFolder = myNameSpace.GetDefaultFolder(olFolderDeletedItems)
    For Each objItem In objDeletedFolder.Items
        Set objProperty = objItem.UserProperties.Find("Deleted")
        If TypeName(objProperty) <> "Nothing" Then
            objItem.Delete
        End If
    Next

Set objDeletedFolder=myNameSpace.GetDefaultFolder（olFolderDeletedItems）
对于objDeletedFolder.Items中的每个objItem
Set objProperty=objItem.UserProperties.Find（“已删除”）
如果TypeName（objProperty）“Nothing”，则
删除
如果结束
下一个

您可以使用以下方法，基本上您可以像当前一样删除所有电子邮件，然后调用这一行清空“已删除邮件”文件夹。代码在jscript中，但如果您真的需要，我可以翻译：）

---

最简单的解决方案，类似于第一种方法：

  FindID = deleteme.EntryID
  deleteme.Delete
  set deleteme = NameSpace.GetItemFromID(FindID)
  deleteme.Delete

---

再做两次，它就会永远消失，不会导致性能下降。（名称空间可以是一个特定的名称空间变量，如果不在默认存储中的话。）请注意，这只在不跨存储删除时有效，这可能会更改EntryID或将其完全删除。

我知道这是一个旧线程，但由于我最近有理由编写一个执行此操作的宏，所以我想我应该共享它。我发现Remove方法似乎是一个永久删除。我正在使用以下代码段：

While oFilteredItems.Count > 0
    Debug.Print "   " & oFilteredItems.GetFirst.Subject
    oFilteredItems.Remove 1
Wend

首先，我列出了一些经过筛选的项目。然后，我只是一次删除一个，直到它消失

---

HTH

最近我不得不永久删除所有联系人。这对我很有用（2016年展望）。您已获得对垃圾箱文件夹中项目的新引用，否则它会显示“已删除”或类似内容。只要从末尾开始，最近移动的项目就会出现。然后调用Delete实现永久删除。此代码段可以在循环中使用

    myContacts(i).Move (trashFolder)
    trashCount = trashFolder.Items.Count
    For j = trashCount To 1 Step -1
        Set trashItem = trashFolder.Items(j)
        If trashItem.MessageClass = "IPM.Contact" Then
            trashItem.Delete
        Else
            Exit For
        End If
    Next

---

我不想使用CDO或RDO，因为我在这里的全部目的是降低代码复杂性，并且我不想引入所有新的依赖项。第二个是我现在正在做的基本事情。我首先做（伪）：对于inbox中的每个消息msg.delete'//移动到deletedItems msg.delete'//中每个消息的下一个已删除项目下一个永久删除，而我想做的是：对于inbox中的每个消息。delete（permanent=true）next2000年没有这样的方法。您必须在VBA中创建自己的函数。移动删除或循环有什么问题？这是性能吗？它没有本质上的“错误”，我只是在寻找一种比依赖两个循环更干净的方法。无论如何，谢谢。对于RDO，您可以将行objRDOSession.Logon替换为objRDOSession.MAPIOBJECT=Application.Sessionn.MAPIOBJECT+1，但我会使用FindControl ID确保它在非英语版本的Outlook上工作。太好了！我确认它对我有效。我在VBA宏中使用测试文件夹上的Application.ActiveExplorer.CurrentFolder.Items.Remove（1）。这仅适用于PST存储，其中邮件条目id在移动到其他文件夹时不会更改。它在Exchange存储区（缓存或联机）中无法工作。最近是否更改了此设置？我最初是为Exchange 2007邮箱执行此操作的。不，PST存储与Exchange的情况一直如此。

  FindID = deleteme.EntryID
  deleteme.Delete
  set deleteme = NameSpace.GetItemFromID(FindID)
  deleteme.Delete

While oFilteredItems.Count > 0
    Debug.Print "   " & oFilteredItems.GetFirst.Subject
    oFilteredItems.Remove 1
Wend

    myContacts(i).Move (trashFolder)
    trashCount = trashFolder.Items.Count
    For j = trashCount To 1 Step -1
        Set trashItem = trashFolder.Items(j)
        If trashItem.MessageClass = "IPM.Contact" Then
            trashItem.Delete
        Else
            Exit For
        End If
    Next