创建VBA宏以保存电子邮件副本

我使用Outlook（MS Exchange），有一个个人和两个组收件箱（我正在使用个人档案登录，通过个人档案我也可以访问组收件箱）

当我发送电子邮件时，我在

From

字段中选择我的个人或两个组中的一个电子邮件地址。发送电子邮件时，我希望在

myIndividualMailbox

、

groupAMailbox

或

groupBMailbox

的收件箱中保存一份副本，具体取决于我使用的

电子邮件地址

示例：如果我从

groupA@myCompany.com，我想要一份保存在

组邮箱

收件箱中的电子邮件副本（而不是我个人的收件箱）

我知道，在Outlook中设置规则是不可能的，但可以使用VBA宏来实现。我现在不知道如何编写VBA宏，也不知道这是一个简短的脚本还是更复杂的脚本。事实上，我从未在Outlook中编写过宏，所以我甚至不知道如何开始。有人能告诉我怎么做吗

---

我开始寻找解决这个问题的方法：

我为你做了这个，据我所知，它是有效的。您应该将其放在Microsoft Outlook对象-ThisOutlookSession模块中

请注意，

myolApp\u ItemSend

事件将永远不会触发，除非您首先运行

enableEvents

。并且，您需要确保每次关闭重新打开的Outlook时都已启用该功能。这将需要一些定制，但它应该给你一个大致的想法

Option Explicit
Public WithEvents myolApp  As Outlook.Application

Sub enableEvents()
    Set myolApp = Outlook.Application
End Sub

Private Sub myolApp_ItemSend(ByVal item As Object, Cancel As Boolean)
    Dim items As MailItem
    Dim copyFolder As Outlook.Folder
    Dim sentWith As String
    'Identify sender address
    If item.Sender Is Nothing Then
        sentWith = item.SendUsingAccount.SmtpAddress
    Else
        sentWith = item.Sender.Address
    End If

    'Determin copy folder based on sendAddress
    Select Case sentWith
        Case "groupA@myCompany.com"
            'get groupAMailbox's inbox
            Set copyFolder = Application.GetNamespace("MAPI").folders("groupAMailbox").folders("Inbox")
        Case "myE-mailAddress"
            'get My inbox
            Set copyFolder = Application.GetNamespace("MAPI").folders("myE-mailAddress").folders("Inbox")
    End Select

    'copy the Item
    Dim copy As Object
    Set copy = item.copy
    'move copy to folder
    copy.Move copyFolder

End Sub

---

编辑：看起来他们现在已经直接将事件功能构建到Outlook的应用程序对象中，但从测试结果来看，您仍然需要执行我上面概述的操作

Outlook将所有已发送邮件存储在默认的“已发送邮件”文件夹中。但是，您可以应用修补程序将发送的项目保存在其自己的文件夹中。