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

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