使用 VBA 永久删除 Outlook 中的邮件消息？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/1110612/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Permanently Delete MailMessage in Outlook with VBA?
提问by eidylon
I am looking for a way to permanently delete a MailMessage from Outlook 2000 with VBA code. I'd like to do this without having to do a second loop to empty the Deleted items.
我正在寻找一种使用 VBA 代码从 Outlook 2000 中永久删除 MailMessage 的方法。我想这样做而不必进行第二次循环来清空已删除的项目。
Essentially, I am looking for a code equivalent to the UI method of clicking a message and hitting SHIFT+DELETE.
本质上，我正在寻找与单击消息并点击SHIFT+的 UI 方法等效的代码DELETE。
Is there such a thing?
有这样的事情吗？
回答by 76mel
Try moving it first then deleting it (works on some patchs in 2000) or use RDO or CDO to do the job for you (you will have to install them)
尝试先移动它然后删除它（适用于 2000 年的某些补丁）或使用 RDO 或 CDO 为您完成这项工作（您必须安装它们）
Set objDeletedItem = objDeletedItem.Move(DeletedFolder)
objDeletedItem.Delete
CDO way
CDO方式
Set objCDOSession = CreateObject("MAPI.Session")
objCDOSession.Logon "", "", False, False
Set objMail = objCDOSession.GetMessage(objItem.EntryID, objItem.Parent.StoreID)
objMail.Delete
set objRDOSession = CreateObject("Redemption.RDOSession")
objRDOSession.MAPIOBJECT = objItem.Session.MAPIOBJECT
set objMail = objRDOSession.GetMessageFromID(objItem.EntryID>)
objMail.Delete
You could also mark the message first before you delete it and the loop through the deleted items folder and find it an dthe call delete a second time. Mark it using a Userproperty.
您还可以在删除邮件之前先标记该邮件，然后循环遍历已删除的项目文件夹，然后再次找到它并调用 delete。使用用户属性标记它。
objMail.UserProperties.Add "Deleted", olText
objMail.Save
objMail.Delete
loop through you deleted items look for that userprop
遍历您已删除的项目以查找该 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
回答by SilverbackNet
Simplest solution of all, similar to the first way:
最简单的解决方案，类似于第一种方式：
FindID = deleteme.EntryID
deleteme.Delete
set deleteme = NameSpace.GetItemFromID(FindID)
deleteme.Delete
Do it twice and it'll be gone for good, and no performance killing loop. (NameSpace can be a particular namespace variable, if not in the default store.) Note this only works if you don't delete across stores, which can change the EntryID or remove it entirely.
做两次，它就会一去不复返，并且没有性能终止循环。（NameSpace 可以是特定的命名空间变量，如果不在默认存储中。）请注意，这仅在您不跨存储删除时才有效，这可以更改 EntryID 或完全删除它。
回答by end-user
I know this is an old thread, but since I recently had cause to write a macro that does this, I thought I'd share. I found that the Remove method appears to be a permanent deletion. I'm using this snippet:
我知道这是一个旧线程，但由于我最近有理由编写一个执行此操作的宏，我想我会分享。我发现Remove方法好像是永久删除。我正在使用这个片段：
While oFilteredItems.Count > 0
Debug.Print " " & oFilteredItems.GetFirst.Subject
oFilteredItems.Remove 1
Wend
I begin with a list of items that have been filtered by some criteria. Then, I just delete one at a time until it's gone.
我从按某些标准过滤的项目列表开始。然后，我一次删除一个，直到它消失。
HTH
HTH
回答by Marcus Pope
You can use the following approach, basically you delete all of your email messages as you are currently doing, then call this one line to empty the deleted items folder. The code is in jscript, but I can translate if you really need me to :)
您可以使用以下方法，基本上您可以像当前一样删除所有电子邮件，然后调用这一行来清空已删除项目文件夹。代码在 jscript 中，但如果您真的需要我，我可以翻译:)
var app = GetObject("", "Outlook.Application"); //use new ActiveXObject if fails
app.ActiveExplorer().CommandBars("Menu Bar").Controls("Tools").Controls('Empty "Deleted Items" Folder').Execute();
回答by Mr. TA
Recently I had to permamentnly delete all contacts. This worked for me (Outlook 2016). You have obtain new reference to the item in the trash folder, otherwise it says "already deleted" or something like that. Just go from the end and the recently moved items will be there. Then calling Delete achieves permanent deletion. This snippet can be used in a loop.
最近我不得不永久删除所有联系人。这对我有用（Outlook 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
