CODEWITHSUNDEEP
vbaoutlook
Fred
Fred

Reputation: 493

Creating VBA macro to save email copy

I use Outlook (MS Exchange) and have an individual as well as two group inboxes (I'm working logged in with the individual profile through which I also have access to the group inboxes).

When I send an email, I chose either my individual or one of the two group email addresses in the From field. When the email is sent, I want a copy saved in the inbox of myIndividualMailbox, groupAMailbox, or groupBMailbox depending on which From email address I used.

Example: If I send an email From groupA@myCompany.com, I want a copy of the email saved in the inbox of the groupAMailbox (and not in my individual inbox).

I have understood that this is not possible by setting up a rule in Outlook but that it could be done with a VBA macro. I don't now how to write the VBA macro and don't know if this is a just a short script or more complicated. In fact I have never written a macro in Outlook so I don't even know how to begin. Can anyone show how to do this?

I started looking for a solution with this question: Outlook send-rule that filter on the 'From' field

Upvotes: 2

Views: 9568

Answers (2)

user221600
user221600

Reputation: 1

Outlook stores all sent items in default sent items folders. however you can apply a patch to save sent items in its own folder. http://support.microsoft.com/kb/2181579

Upvotes: 0

Daniel
Daniel

Reputation: 13142

I made this for you as far as I can tell, it works. You should put this in the Microsoft Outlook Objects - ThisOutlookSession Module.

Note that the myolApp_ItemSend event will never trigger unless you run enableEvents first. And you will need to make sure it is enabled every time you close an re-open Outlook. This will take some customization, but it should give you the general idea.

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

EDIT: It looks like they've actually built the event functionality into the Application object for Outlook directly now, but it from testing you still have to do what I outlined above.

Upvotes: 1

Related Questions