Hello again Gurus
I posted a similar question back in February (sorry but I'm not allowed to post the link). Graham was able to help me out an I have been using the following code since:
Option Explicit
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim R As Outlook.Recipient
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Const strCompany As String = " [COMPANY]"
Const sAddress As String = "insert email address here"
Const strText As String = "This text is added to the start of the message" & vbCr & vbNewLine
With Item
'this part should not be required as Outlook will warn of a missing subject
If Trim(.Subject) = "" Then
MsgBox "The subject is missing", vbInformation
Cancel = True
GoTo lbl_Exit
End If
'Add [COMPANY NAME] to Subject for all emails where that text doesn't already exist
If InStr(1, .Subject, strCompany) = 0 Then
.Subject = .Subject & strCompany
End If
'Send a BCC copy of every Email to yourself, change email address as required
Set R = .Recipients.Add(sAddress)
R.Type = olBCC
R.Resolve
'Add text to start of message
.Display
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
oRng.Text = strText
End With
lbl_Exit:
Exit Sub
End Sub
The issue is that I've now been asked to add a marker to the end of the subject line for selected emails (those of a personal nature). I've amended the code to include:
Const strPersonal As String = " [Personal]"
and
'Add [Personal] to Subject for all emails where that text doesn't already exist
If InStr(1, .Subject, strPersonal) = 0 Then
.Subject = .Subject & strPersonal
End If
But this change doesn't allow me to add the marker to selected emails – it adds it to all of them. What I need is a message box that asks if I want to add the marker and then append it if I select 'yes' or do nothing if I select 'no'. I tried modifying the above code myself but I ended up with too many IF statements.
Thanks for any help you can provide.
Cheers,
Mikky.