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

Delete email from inbox and also delete it from deleted-items folder via rule->script

提问by and0r

I created a rule, that starts a VBA-script depending on the subject of a received email (Rule: Subject "MY_SUBJECT" -> start script).
The VBA script is then doing some stuff and then it should finally delete the original email.

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

This part is easy:

这部分很简单：

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

' delete email from inbox
Item.Delete
End Sub

Now the email will sit in the deleted-items-folder. But what I need to achieve is, to also delete this mail from the deleted-items folder. Since I know the subject of this mail (because this triggered my rule in the first place), I tried the following approach:

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

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

Well, this basically works: The mail with this subject will be found in the deleted-items-folder and it will be deleted, yes. But sadly it does not work as expected: This permanent deletion only works once I start the script a second time.

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

So the email which is triggering my script will never be deleted permanently in this script's actual run, but only in the next run (once the next email with the trigger-subject for my rule is received - but then this very next email won't be deleted, again).

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

Do you have any idea what I am doing wrong here? It somehow looks like I need to refresh my deleted-items folder somehow. Or do I have to comit my first Item.Deletesomehow explicitly?

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

回答by niton

The problem was not recreated, but try stepping through this then run normally if it appears to do what you want.

问题没有重现，但是如果它看起来像您想要的那样，请尝试逐步执行此操作然后正常运行。

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

回答by Sir Rolin

the Mailbox folder that you get can be used as a collection, meaning that you can remove the item directly, you will need the collection to be sent to the function but that should be managable :)

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

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

Remember that IF you want to Delete more than 1 Item per call of "For Ite = 1 To Mailbox.Items.Count", you will need to subtract 1 from the check of the item within the For segment since when you remove a mail from it, it will reduce the rest of the mails index number by 1.

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

Hope you can still use this :)

希望你仍然可以使用这个:)

Regards Sir Rolin

问候罗林爵士

回答by and0r

Tim Williams suggested another existing thread. I had a look at that already before and decided that appoach would be exactly the same representation of my bug. I did try it out, though (to show my motiviation :) ), but the behaviour is - as expected - exactly the same: Again the final deletion only works once the next time the script is triggered via rule:

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

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

I would be really glad to get some help here. I also wanted to comment on that other thread, but my reputation is not enough, yet.

我真的很高兴在这里得到一些帮助。我也想对另一个线程发表评论，但我的声誉还不够。

回答by 0m3r

Try something like this, code goes under ThisOutlookSession

尝试这样的事情，代码在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

Edit

编辑

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