从收件箱中删除电子邮件，并通过规则->脚本将其从已删除项目文件夹中删除答案

【问题标题】：Delete email from inbox and also delete it from deleted-items folder via rule->script从收件箱中删除电子邮件，并通过规则->脚本将其从已删除项目文件夹中删除
【发布时间】：2017-06-12 07:24:25
【问题描述】：

我创建了一个规则，它根据收到的电子邮件的主题启动一个 VBA 脚本（规则：主题“MY_SUBJECT”-> 启动脚本）。
然后 VBA 脚本正在做一些事情，然后它最终应该删除原始电子邮件。

这部分很简单：

Sub doWorkAndDeleteMail(Item As Outlook.MailItem)
' doSomething:

' delete email from inbox
Item.Delete
End Sub

现在电子邮件将位于已删除项目文件夹中。但我需要实现的是，还要从已删除项目文件夹中删除此邮件。因为我知道这封邮件的主题（因为这首先触发了我的规则），所以我尝试了以下方法：

Sub doWorkAndDeleteMail(Item As Outlook.MailItem)
' doSomething:

' delete email from inbox
Item.Delete
End Sub

' delete email from deleted items-folder
Dim deletedFolder As Outlook.Folder

Set deletedFolder = Application.GetNamespace("MAPI"). _
    GetDefaultFolder(olFolderDeletedItems)

Dim i As Long
For i = myFolder.Items.Count To 1 Step -1

If (deletedFolder.Items(i).Subject) = "MY_SUBJECT" Then

deletedFolder.Items(i).Delete
Exit For
End If
Next if

End Sub

嗯，这基本上是可行的：具有此主题的邮件将在已删除项目文件夹中找到，并且将被删除，是的。但遗憾的是它没有按预期工作：这种永久删除仅在我第二次启动脚本后才有效。

因此，触发我的脚本的电子邮件将永远不会在此脚本的实际运行中被永久删除，而只会在下一次运行中被删除（一旦收到下一封带有我的规则的触发器主题的电子邮件 - 但接下来的这封电子邮件不会再次被删除）。

你知道我在这里做错了什么吗？不知何故，我似乎需要以某种方式刷新我的已删除项目文件夹。还是我必须以某种方式明确地提交我的第一个Item.Delete？

【问题讨论】：

stackoverflow.com/questions/1110612/…
我以前见过这个解决方案，是的。我没有安装 RDO 或 CDO（我也想要一个独立的解决方案）。那里的第三个方法（用属性标记邮件）对我来说看起来完全一样：我搜索主题或其他属性并不重要。在该线程的底部，有人声称有一种“删除”方法可以从一开始就永久删除邮件项目。但是对于“Outlook.MailItem”类型（这是脚本的输入）似乎不存在这种删除方法。无论如何：我想知道我的方法有什么问题。
我尝试了设置并搜索了一个主题：正如预期的那样，行为完全一样。删除仅在下次运行脚本时有效。
您是否尝试过该答案中的第一种方法 - 将项目移动到已删除文件夹，然后将其删除？
@TIm Williams 是的，但这只是将它移到那里。最后的删除没有发生 - 它的行为再次表现，好像它当时并不真正在该文件夹中......

标签： vba email outlook outlook-2010

【解决方案1】：

Tim Williams 提出了另一个现有线程。我之前已经看过了，并决定该方法与我的错误完全相同。不过，我确实尝试过（以显示我的动机:)），但行为 - 正如预期的那样 - 完全相同：再次，最终删除仅在下次通过规则触发脚本时才有效：

Sub doWorkAndDeleteMail(Item As Outlook.MailItem)
' First set a property to find it again later
Item.UserProperties.Add "Deleted", olText
Item.Save
Item.Delete

'Now go through the deleted folder, search for the property and delete item
Dim objDeletedFolder As Outlook.Folder
Dim objItem As Object
Dim objProperty As Variant

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

End Sub

我真的很高兴在这里得到一些帮助。我也想评论其他帖子，但我的声誉还不够。

【讨论】：

顺便说一下，我还尝试了一种方法，在“从收件箱中删除”和“从已删除的项目中删除”之间等待 5 秒，使用一个等待滴答声的 while 循环（使用标准的“睡眠”整个应用程序会挂起），但这种等待在这里也没有帮助。我肯定在这里遗漏了一些东西...... :( deleted-Items 文件夹似乎在下一个脚本运行之前不知道该已删除项目。但为什么不呢？
当项目移动到已删除文件夹时，您是否尝试过 itemAdd 甚至欺骗删除？或者我一旦您的规则完成某事，然后运行循环以从收件箱中删除项目 - 如果您需要示例，请告诉我
@0m3r ，我不知道该怎么做。一个例子会很好。谢谢！
不要使用 For Each - 如果你要删除你应该使用 For 和 Step reverse loop
问题不是那种循环恕我直言。它是，该项目似乎并不真正在“已删除项目”内。也许它有什么关系，这个脚本是通过规则触发的？

【解决方案2】：

试试这样，代码在 ThisOutlookSession

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Dim DeletedFolder  As Outlook.MAPIFolder

    Set olNs = Application.GetNamespace("MAPI")
    Set DeletedFolder = olNs.GetDefaultFolder(olFolderDeletedItems)
    Set Items = DeletedFolder.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    Dim olNs As Outlook.NameSpace
    Dim DeletedFolder As Outlook.MAPIFolder
    Dim Items As Outlook.Items
    Dim Filter As String
    Dim i As Long

    Set olNs = Application.GetNamespace("MAPI")
    Set DeletedFolder = olNs.GetDefaultFolder(olFolderDeletedItems)

    Filter = "[Subject] = 'MY_SUBJECT'"

    Set Items = DeletedFolder.Items.Restrict(Filter)

    If TypeOf Item Is Outlook.MailItem Then

        For i = Items.Count To 1 Step -1
            DoEvents
            Items.Remove i
        Next

    End If
End Sub

编辑

Sub doWorkAndDeleteMail(Item As Outlook.MailItem)
    ' First set a property to find it again later
    Item.UserProperties.Add "Deleted", olText
    Item.Save
    Item.Delete

    'Now go through the deleted folder, search for the property and delete item
    Dim olNs As Outlook.NameSpace
    Dim DeletedFolder As Outlook.MAPIFolder
    Dim Items As Outlook.Items
    Dim Filter As String
    Dim i As Long

    Set olNs = Application.GetNamespace("MAPI")
    Set DeletedFolder = olNs.GetDefaultFolder(olFolderDeletedItems)

    Filter = "[Subject] = 'MY_SUBJECT'"

    Set Items = DeletedFolder.Items.Restrict(Filter)

    If TypeOf Item Is Outlook.MailItem Then

        For i = Items.Count To 1 Step -1
            DoEvents
            Items.Remove i
        Next

    End If
End Sub

【讨论】：

感谢您的回复。我在 This Outlook-Session 下复制了这个脚本，并向自己发送了一封主题为“MY_SUBJECT”的电子邮件。然后我手动将其从收件箱中删除。但它仍然显示在删除项目文件夹中。这很奇怪。我必须以某种方式激活事件吗？
@and0r 添加代码后是否重新启动了 Outlook
是的，我做到了。对你起作用吗？我正在使用 Office 365（Outlook v16.0...）
@and0r 哦，我在 2010 年，尝试将我的循环复制到您的代码中，看看是否有帮助
感谢您的编辑，但您的第二个提案再次涉及该领域，就像我之前所做的那样。现在的行为再次是它将邮件移动到“已删除项目”，但不会在那里删除它。它只会在收到另一个（第二个）具有该主题的邮件后将其删除。当然，这之后的第二封电子邮件将在“删除项目”中。这只会在第三封邮件到达时被删除……以此类推

【解决方案3】：

问题未重现，但尝试逐步解决，然后正常运行，如果它看起来像你想要的那样。

Sub doWorkAndDeleteMail(Item As mailitem)

Dim currFolder As Folder
Dim DeletedFolder As Folder

Dim i As Long
Dim mySubject As String

Set currFolder = ActiveExplorer.CurrentFolder
mySubject = Item.Subject
Debug.Print mySubject

Set DeletedFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems)

Set ActiveExplorer.CurrentFolder = DeletedFolder

Debug.Print "DeletedFolder.count before delete: " & DeletedFolder.Items.count
' delete email from deleted items-folder
Item.Delete
Debug.Print "DeletedFolder.count  after delete: " & DeletedFolder.Items.count

' If necessary
'DoEvents

For i = DeletedFolder.Items.count To 1 Step -1

    Debug.Print DeletedFolder.Items(i).Subject

    If (DeletedFolder.Items(i).Subject) = mySubject Then

        Debug.Print DeletedFolder.Items(i).Subject & " *** found ***"

        DeletedFolder.Items(i).Delete

        Exit For

    End If
Next

Set ActiveExplorer.CurrentFolder = currFolder

End Sub

【讨论】：

【解决方案4】：

您获得的邮箱文件夹可以用作集合，这意味着您可以直接删除项目，您需要将集合发送到函数但应该是可管理的:)

Sub doWorkAndDeleteMail(Mailbox As Outlook.Folder, Item As Outlook.MailItem)
' doSomething:

' delete email from inbox
For Ite = 1 To Mailbox.Items.Count
    If Mailbox.Items(Ite).EntryID = Item.EntryID Then
        Mailbox.Items.Remove Ite
        Exit For
    End If
Next
End Sub

请记住，如果您想在每次调用“For Ite = 1 To Mailbox.Items.Count”时删除 1 个以上的项目，则需要从删除 For 段中的项目的检查中减去 1来自它的邮件，它会将其余邮件索引号减少1。

希望你仍然可以使用它:)

问候罗林爵士

【讨论】：