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:
- Open Visual Basic Editor in Outlook with Alt-F11.
- Choose “ThisOutlookSession”. This file should be empty for most users.
- Copy the macro code into the file and select “Debug” -> “Compile” to make sure there are no errors.
- Close the VB Editor
- Change your macro security settings to allow macros with notifications.
- 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
Pingback: Send and archive e-mails VBA macro in Outlook at design it simple – sense
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.
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
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