Outlook “Send and archive”

Do you still save all your incoming emails in separate folders and keep all your outgoing emails in your sent items folder? Here’s a VBA macro for Outlook (2000 – 2010 beta) that allows you to archive emails to the folder of your choice right when you click on “Send e-mail”.

In addition, it will also look for keywords that indicate that you wanted to attach a file, but forgot it.

Installation instructions:

  1. Open Visual Basic Editor in Outlook with Alt-F11.
  2. Choose “ThisOutlookSession”. This file should be empty for most users.
  3. Copy the macro code into the file and select “Debug” -> “Compile” to make sure there are no errors.
  4. Close the VB Editor
  5. Change your macro security settings to allow macros with notifications.
  6. Restart Outlook.

If you have trouble send an email to michael@designitsimple.de

VBA code

Dim objFolder As MAPIFolder

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'************************************
' Author:           Michael Hartmann, michael@designitsimple.de
' Description:      Performs various checks upon sending an email
'
' Version
' 1.0, July 24, 2006: Creation
' 1.1, June 21, 2010: Deleted check for IsInDefaultStore
'************************************

 ' Variable declaration
 Dim objNS As NameSpace
 Dim colKeywords As New Collection
 Dim vntRecipients As Variant
 Dim bolExternalEmail As Boolean

 ' Set variables
 Set objNS = Application.GetNamespace("MAPI")

 ' Set up list of keywords that you use when attaching files
 colKeywords.Add "attachement"
 colKeywords.Add "Attachement"
 colKeywords.Add "attached"
 colKeywords.Add "Attached"

 ' Check for attechment keywords and check for number of attachments
 If checkForKeywords(colKeywords, Item.Body) And (Item.Attachments.Count = 0) Then

 ' If attachments should be in email ask for continue
 If MsgBox("Attachement missing. Send e-mail anyway?", vbYesNo) = vbNo Then
 Cancel = True
 Exit Sub
 End If

 End If

 ' Check for subject
 If Item.Subject = "" Then
 MsgBox "Please specify a subject"
 Cancel = True
 Exit Sub
 End If

 ' Only enable actions for emails
 If Item.Class = olMail Then

 ' Get folder to save email
 Set objFolder = objNS.PickFolder

 ' Check if folder has been specified
 If TypeName(objFolder) <> "Nothing" Then

 ' If folder has been specified move email
 Set Item.SaveSentMessageFolder = objFolder
 Else
 ' Otherwise do not send email and get back to email
 Cancel = True
 End If

 End If

send_message:
 ' Unset everything
 Set objFolder = Nothing
 Set objNS = Nothing

End Sub

Private Function checkForKeywords(colKeyWordList As Collection, strText As String) As Boolean
'************************************
' Author:           Michael Hartmann, michael@designitsimple.de
' Last modified:    August, 8th 2006
'
' Description:      Checks for certain keywords from a collection in a string
'************************************

 ' Variable declaration
 Dim varKeyword As Variant

 ' Set initial return variable.
 checkForKeywords = False

 For Each varKeyword In colKeyWordList
 If (InStr(1, strText, varKeyword, vbTextCompare) > 0) Then
 checkForKeywords = True
 Exit Function
 End If
 Next

End Function

12 Comments

  1. Greetings, this is a truly absorbing web weblog and I’ve cherished learning lots of on the content material and posts contained on the internet website, keep up the excellent get the job done and wish to learn a good deal far more stimulating articles in the future.

    January 21, 2011
    Reply
  2. Manuel Chirouze said:

    Hi,

    I was looking for something like this for a while and I loved your piece of code, thank you!

    I made a further modification which handles the original email and stores it in the same folder given a couple rules (only when the original email is in the Inbox folder, and if the folder the email is being moved to is not the Deleted Items folder).

    Best regards,
    Manuel Chirouze

    Dim objFolder As MAPIFolder

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    ‘************************************
    ‘ Author: Michael Hartmann, michael@designitsimple.de
    ‘ Description: Performs various checks upon sending an email

    ‘ Version
    ‘ 1.0, July 24, 2006: Creation
    ‘ 1.1, June 21, 2010: Deleted check for IsInDefaultStore
    ‘ 1.2 Feb 1, 2011: Further modified by Manuel Chirouze to also store the original email in the same folder
    ‘************************************

    ‘ Variable declaration
    Dim objNS As NameSpace
    Dim colKeywords As New Collection
    Dim vntRecipients As Variant
    Dim bolExternalEmail As Boolean

    ‘ Set variables
    Set objNS = Application.GetNamespace(“MAPI”)

    ‘ Set up list of keywords that you use when attaching files
    colKeywords.Add “attachement”
    colKeywords.Add “Attachement”
    colKeywords.Add “attached”
    colKeywords.Add “Attached”

    ‘ Check for attechment keywords and check for number of attachments
    If checkForKeywords(colKeywords, Item.Body) And (Item.Attachments.Count = 0) Then

    ‘ If attachments should be in email ask for continue
    If MsgBox(“Attachement missing. Send e-mail anyway?”, vbYesNo) = vbNo Then
    Cancel = True
    Exit Sub
    End If

    End If

    ‘ Check for subject
    If Item.Subject = “” Then
    MsgBox “Please specify a subject”
    Cancel = True
    Exit Sub
    End If

    ‘ Only enable actions for emails
    If Item.Class = olMail Then

    ‘ Get folder to save email
    Set objFolder = objNS.PickFolder

    ‘ Check if folder has been specified
    If TypeName(objFolder) “Nothing” Then

    ‘ If folder has been specified move email
    Set Item.SaveSentMessageFolder = objFolder

    ‘If the active item has the same ConversationTopic as the reply/forward item then do the same with in.
    ‘Only if the message is in the inbox and the destination is not the trash

    If objFolder.Name “Deleted Items” Then

    Dim myOlExp As Outlook.Explorer
    Dim myOlSel As Outlook.Selection
    Dim myMailItem As Outlook.MailItem
    Set myOlExp = Application.ActiveExplorer
    Set myOlSel = myOlExp.Selection

    If myOlExp.CurrentFolder = “Inbox” Then
    ‘Only if there is only one item
    If myOlSel.Count = 1 Then
    ‘Only if it is a mail item
    If myOlSel.Item(1).Class = olMail Then
    Set myMailItem = myOlSel.Item(1)
    ‘Only if it has the same conversation topic
    If myMailItem.ConversationTopic = Item.ConversationTopic Then
    myMailItem.Move objFolder
    End If
    End If
    End If
    End If
    End If

    Else
    ‘ Otherwise do not send email and get back to email
    Cancel = True
    End If

    End If

    send_message:
    ‘ Unset everything
    Set objFolder = Nothing
    Set objNS = Nothing

    End Sub

    Private Function checkForKeywords(colKeyWordList As Collection, strText As String) As Boolean
    ‘************************************
    ‘ Author: Michael Hartmann, michael@designitsimple.de
    ‘ Last modified: August, 8th 2006

    ‘ Description: Checks for certain keywords from a collection in a string
    ‘************************************

    ‘ Variable declaration
    Dim varKeyword As Variant

    ‘ Set initial return variable.
    checkForKeywords = False

    For Each varKeyword In colKeyWordList
    If (InStr(1, strText, varKeyword, vbTextCompare) > 0) Then
    checkForKeywords = True
    Exit Function
    End If
    Next

    End Function

    February 3, 2011
    Reply
  3. michael said:

    Hi Manuel

    Thanks for your feedback and the modifications. Have to check this out the next days but sounds great. I’d usually delete the original mail since my reply contains the original email. I think I have to make that also possibele 😉

    Best regards
    Michael

    February 4, 2011
    Reply
  4. James said:

    hi, the code works great but I noticed the emails tend to hang around in my outbox for a few minutes waiting for the next send and receive action – how can I get it too send emails immediately like does usually? many thanks, James

    May 10, 2012
    Reply
  5. Michael said:

    James

    Well, there’s actually no code line preventing Outlook from sending e-mails immediately. Which version of Outlook do you use and could you please check if that also happens if you’re no enabling the macro.

    -Michael

    May 10, 2012
    Reply
  6. Sylvia Lee said:

    What part of the code can I delete if I want to ‘catch’ unattached attachments but not archive emails? I use Business Contact Manager to link emails to accounts and projects, and also a home network, so don’t want to screw that up.

    If something helps me manage my fingers-faster-than-brain syndrome when it comes to attachments, I’ll be very, very happy! Thank you.

    December 18, 2012
    Reply
    • michael said:

      Hi Sylvia

      Sorry for the late answer… If you only want to check for missing attachements I’d delete the part

      ' Only enable actions for emails
      If Item.Class = olMail Then

      ' Get folder to save email
      Set objFolder = objNS.PickFolder

      ' Check if folder has been specified
      If TypeName(objFolder) <> "Nothing" Then

      ' If folder has been specified move email
      Set Item.SaveSentMessageFolder = objFolder
      Else
      ' Otherwise do not send email and get back to email
      Cancel = True
      End If

      End If

      That should work

      Happy New Year 2013
      Michael

      January 1, 2013
      Reply
  7. Michael D. said:

    Hi Michael,

    I love your macro, thanks for your efforts! I would like to have the “send items” folder as default for saving outgoing mails, any idea how to include this in your macro?!?

    Kind regards and a great 2013, Michael

    January 3, 2013
    Reply
  8. michael said:

    Hi Michael

    Isn’t “sent items” always the default? Which folder is selected when you execute it?

    Happy New Year for you too
    Michael

    January 3, 2013
    Reply
  9. Vincent V. said:

    Hi Michael,
    I appreciate very much your macro as I am coming from Lotus Notes/Domino world where “send and archive” exist by default (like in GMail)
    I just upgrade to Office 2013 and it seems your macro doesn’t work anymore with that version. Have you any idea why ?

    Vincent

    November 15, 2013
    Reply
    • michael said:

      Hi Vincent,

      This might be due to security settings, I do have Outlook 2013 and the macro running together. Unfortunately my PC is being repaired currently and I can’t check the exact settings. I’ll send you a screenshot as soon as I have it back.

      Regrads
      Michael

      November 15, 2013
      Reply

Leave a Reply

Your email address will not be published. Required fields are marked *