Question

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

这部分很简单：

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

' delete email from inbox
Item.Delete
End Sub

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

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

嗯，这基本上有效：带有这个主题的邮件将在deleted-items-folder中找到，它将被删除，是的。但遗憾的是它不能按预期工作：只有在我第二次启动脚本时，此永久删除才有效。

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

你知道我在做错了什么吗？它看起来像我需要以某种方式刷新我的已删除项目文件夹。或者我是否必须以某种方式明确地说出我的第一个Item.Delete？

Answer 1

问题没有重新创建，但尝试单步执行此操作然后正常运行，如果它看起来像你想要的那样。

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

Answer 2

蒂姆威廉姆斯建议另一个现有的线程。我之前看过那个，并决定appoach与我的bug完全相同。我确实试过了（显示我的动机:)），但行为是 - 正如预期的那样 - 完全相同：最后删除只在下次通过规则触发脚本时才有效：

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

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

Answer 3

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

Answer 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”要删除多个项目，则自删除后，您需要从For段中的项目检查中减去1一封邮件，它将其余邮件索引号减少1。

希望您仍然可以使用它：）

关于罗琳爵士

从收件箱中删除电子邮件，并通过rule-＆gt;脚本

4 个答案: