Vba 如何使Outlook在收到任何内容时自动清除文件夹？

我希望可以问这样的问题。目前，我完全无法尝试自己编写代码

我需要一个Outlook 2007宏，该宏将在收到任何内容时永久删除“已发送邮件”文件夹中的所有内容。可能吗？如何设置所有内容，以便用户无需单击任何内容即可运行它

我知道我想要一条鱼，我很尴尬，但我真的需要这个东西

编辑：

我已将其粘贴到VBA编辑器的新模块中：

Public Sub EmptySentEmailFolder()

Dim outApp As Outlook.Application
Dim sentFolder As Outlook.MAPIFolder
Dim item As Object
Dim entryID As String

Set outApp = CreateObject("outlook.application")
Set sentFolder = outApp.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)

For i = sentFolder.Items.Count To 1 Step -1
    sentFolder.Items(i).Delete             '' Delete from mail folder
Next
Set item = Nothing
Set sentFolder = Nothing
Set outApp = Nothing
End Sub

这只是我在这个网站上找到的删除已删除邮件的代码的一个稍加修改的版本。当我运行它时，它会删除“已发送邮件”文件夹。您能帮我修改它吗？这样，每当文件夹中出现任何内容时，它都会删除已发送的项目，并且用户无需单击任何内容即可运行它？我需要一个完全自动化的过程

编辑2:如果您认为有比VBA更好的工具来实现这一点，请毫不犹豫地编辑标记和注释

编辑3:我做了一些有时有效，但有时无效的事情。而且复杂得可笑。我设定了一个规则，即ccs发送的每封电子邮件都附有我的附件。另一条规则是当我的电子邮件到达时运行以下代码

Sub Del(item As Outlook.MailItem)
Call EmptySentEmailFolder
End Sub

这个东西有三种行为，我还不能确定是什么触发了哪种行为。有时会清除“已发送邮件”文件夹。有时它什么也不做。有时第二条规则会给出“操作失败”错误消息

无论什么时候，只要我的地址里有什么东西，就采取行动的想法是非最佳的，因为为了简洁起见，我将省略这些原因。我试着用报告代替它。我制定了一个规则，每当我发送电子邮件时都会发送一份交付报告。然后，另一条规则在收到报告后运行代码。然而，这只有一个行为：它从不做任何事情

---

这两个想法都非常复杂，任何事情都可能出问题，我在调试它们时遇到了困难。这两个都是非最佳解决方案。

这是一个可接受的解决方案吗？抱歉，时间太晚了，但我的Outlook副本已损坏

当您进入Outlook VB编辑器时，项目资源管理器将位于左侧。如果不是，请单击Ctrl+R。它看起来像这样：

+  Project1 (VbaProject.OTM)

或

如果您没有任何用户表单，“表单”将丢失。“模块”可能被扩展。根据需要单击+s以展开“Microsoft Office Outlook对象”：

-  Project1 (VbaProject.OTM)
   -  Microsoft Office Outlook Objects
        ThisOutlookSession
   +  Forms
   +  Modules

单击此Outlook会话。模块区域将变为白色，除非您已使用此代码区域。此区域类似于模块，但具有附加权限。将此代码复制到该区域：

Private Sub Application_MAPILogonComplete()

  ' This event routine is called automatically when a user has completed log in.

  Dim sentFolder As Outlook.MAPIFolder
  Dim entryID As String
  Dim i As Long

  Set sentFolder = CreateObject("Outlook.Application"). _
                        GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)

  For i = sentFolder.Items.Count To 1 Step -1
    sentFolder.Items(i).Delete             ' Move to Deleted Items
  Next

  Set sentFolder = Nothing

End Sub

我已经将您的代码整理好，并将其放入事件例程中。当适当的事件发生时，会自动调用事件例程。当用户完成登录时调用此例程。这不是你所要求的，但这可能是一个可以接受的妥协

建议2

我以前没有在Sent Items文件夹上尝试过ItemAdd事件例程，尽管我在收件箱中使用过它。根据我有限的测试，删除发送的项目不会干扰发送

此代码属于“ThisOutlookSession”

---

Print语句显示您对已发送项目的访问权限有限。如果您尝试访问更敏感的属性，您将触发一个警告，提示用户宏正在评估电子邮件。

我不熟悉这种语言，也没有应用程序可以尝试，但这可能会有所帮助吗？还有，这个：@ParrotMac你好，谢谢。我们遇到了同样的问题。我刚刚编辑了我的问题。您能看一下吗？我的印象是，设置这样的事件侦听器将通过向导完成，而不是代码的一部分——我相信这是“规则和警报”部分的一部分。@ParrotMac我认为这里不是这种情况。通常它会起作用，但发送电子邮件的规则没有“运行脚本”选项。此外，我不希望在发送邮件时运行宏，而是在邮件到达sent Items文件夹时运行宏。前者可能是无用的，因为它可能会清除除刚刚发送的消息之外的所有消息。我所做的是运行一个永久删除消息的规则，但我必须手动运行它。似乎只有在发送或接收邮件（但在收件箱文件夹中接收）时才能自动触发规则。这给了我希望，这可能需要一段代码。谢谢你的回答。所以这个解决方案需要一个普通用户重启Outlook，对吗？我不确定这是否行得通。如果我希望用户按照说明操作，我可以告诉他们在每次发送扫描时手动删除已发送邮件中的邮件。我已经告诉他们了，有些人这样做了，但不是全部。剩下的附件可能包含敏感信息。他们只是不应该待在那里让每个人都看到。如果用户需要重新启动outlook（或relogon），肯定会有人忘记这一点……我没有意识到这些电子邮件包含敏感信息。我想你只是想删除它们，而不必为用户带来任何麻烦。您可以将删除附加到另一个将更频繁发生的事件。我在回答中添加了第二个建议，这可能更好地满足您的要求。

Private Sub Application_MAPILogonComplete()

  ' This event routine is called automatically when a user has completed log in.

  Dim sentFolder As Outlook.MAPIFolder
  Dim entryID As String
  Dim i As Long

  Set sentFolder = CreateObject("Outlook.Application"). _
                        GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)

  For i = sentFolder.Items.Count To 1 Step -1
    sentFolder.Items(i).Delete             ' Move to Deleted Items
  Next

  Set sentFolder = Nothing

End Sub

Option Explicit
Public WithEvents MyNewItems As Outlook.Items
Private Sub Application_MAPILogonComplete()

  Dim NS As NameSpace

  Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")

  With NS
    Set MyNewItems = NS.GetDefaultFolder(olFolderSentMail).Items
  End With

End Sub
Private Sub myNewItems_ItemAdd(ByVal Item As Object)

  Debug.Print "--------------------"
  Debug.Print "Item added to Sent folder"
  Debug.Print "Subject: " & Item.Subject
  Item.Delete             ' Move to Deleted Items
  Debug.Print "Moved to Deleted Items"

End Sub