Add a Prefix (I: ) to a Subject before send email

[Anastasios]

Hi, I’m trying to create a macro in Outlook 2016 where, when the sent button is pressed the mail is caught the (A: ) is entered as prefix in the subject and then the mail is sent.
I have worked out everything and the macro adds the prefix in case of an Outlook email that is opened and has focus, using the ActiveInspector method. However in case of Outlook email that is currently selected in the message list (not opened) and reference the active item by using the ActiveExplorer method, the prefix is not added!
Any suggestions?

Private Sub CommandButton1_Click()
Dim strSubject As String
Dim Item As Outlook.MailItem
Dim objApp As Outlook.Application

Set objApp = CreateObject("Outlook.Application")

Select Case TypeName(objApp.ActiveWindow)
Case "Inspector"
Set Item = objApp.ActiveInspector.CurrentItem
MsgBox "Inspector"
Case "Explorer"
Set Item = objApp.ActiveExplorer.Selection.Item(1)
MsgBox "Explorer"
End Select

strSubject = Item.Subject
Item.Subject = "I: " & strSubject

Set Item = Nothing
Set objApp = Nothing

Unload Me
End Sub

[gmayor]

If you want to add 'I:' before the subject of messages you send then use the following macro in the ThisOutlookSession module


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strSubject As String
If TypeName(Item) = "MailItem" Then
strSubject = Item.Subject
If Not Left(strSubject, 2) = "I:" Then
strSubject = "I:" & strSubject
Item.Subject = strSubject
End If
End If
lbl_Exit:
Exit Sub
End Sub

[Anastasios]

Hi gmayor, thanks for your fast reply. I tried what you sugeested and it works perfectly. However please note that this functionality in my code above takes place in a form under CommandButton1_Click().
Actually I have 3 buttons and with each of them I add a different letter in the subject A: or B: or C:. Any suggestion how to use a form in combination with you reply above? Also why do you use the lbl_Exit in youe sub?

Thanks in advance,
Anastasios.

[gmayor]

To include a userform

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strSubject As String, strText As String
Dim oFrm As New UserForm1 'the name of the userform
If TypeName(Item) = "MailItem" Then
With oFrm
.Show
Select Case .Tag
Case Is = 1: strText = "A:"
Case Is = 2: strText = "B:"
Case Else: strText = "C:"
End Select
End With
Unload oFrm
strSubject = Item.Subject
If Not Left(strSubject, 2) = strText Then
strSubject = strText & strSubject
Item.Subject = strSubject
End If
End If
lbl_Exit:
Set oFrm = Nothing
Exit Sub
End Sub

The userform (here Userform1) code would be

Option Explicit

Private Sub CommandButton1_Click()
Hide
Tag = 1
lbl_Exit:
Exit Sub
End Sub

Private Sub CommandButton2_Click()
Hide
Tag = 2
lbl_Exit:
Exit Sub
End Sub

Private Sub CommandButton3_Click()
Hide
Tag = 3
lbl_Exit:
Exit Sub
End Sub
I frequently work with sometime contributor Greg Maxey (http://gregmaxey.com/word_tips.html) and lbl_Exit: is a common label we use in our projects to mark the end of the macro.
It is a personal programming style preference and not essential to the code.

(http://gregmaxey.com/word_tips.html)

[Anastasios]

Hello Graham,

It worked perfectly!!! Thank you for your Super-Fast reply!
If I'm allowed a very last question, is it possible when I close the form (by pressing the X button) to get back to the mail without sending it?

Thanks in advance,
Anastasios

[gmayor]

Add

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Hide
Tag = 0
Cancel = True
End If
lbl_Exit:
Exit Sub
End Sub

to the userform code and change the main macro to include the extra tag option


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strSubject As String, strText As String
Dim oFrm As New UserForm1 'the name of the userform
If TypeName(Item) = "MailItem" Then
With oFrm
.Show
Select Case .Tag
Case Is = 0: Cancel = True: GoTo lbl_Exit 'the X has been clicked
Case Is = 1: strText = "A:"
Case Is = 2: strText = "B:"
Case Else: strText = "C:"
End Select
End With
Unload oFrm
strSubject = Item.Subject
If Not Left(strSubject, 2) = strText Then
strSubject = strText & strSubject
Item.Subject = strSubject
End If
End If
lbl_Exit:
Set oFrm = Nothing
Exit Sub
End Sub

[Anastasios]

This is just perfect!!! Thank you!