Add sender to subject line

[jamajam]

This is probably quite a simple problem but I've spent days trawling the internet to try and find an answer so I'd be very grateful if someone could put me out of my misery and solve this for me.

At work, we have a main email address used by 3 different people on three different computers. I've set up some rules on each machine but they're dependent on a BCC copy email being emailed back to our main email address but with the initial's of the person who sent it, added to the subject line.

I've used this BCC code below with 'sent by XX' added. This works fine and is just what we need but the problem is, if we reply to an email or forward one, originally sent by us, the 'sent by' bit keeps getting repeated e.g. 'test message subject - sent by XX - sent by XX - sent by XX '
So I just want to get rid of the unwanted extra 'sent by's. I tried by using a delimiter but as I don't really understand what I'm doing, I was unable to get the original subject saved, only the 'sent by' part.
Here is the code with the 'sent by' part added in red:
[vba]Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
Dim objRecip As Recipient
Dim strMsg As String
Dim res As Integer
Dim strBcc As String
On Error Resume Next

' #### USER OPTIONS ####
' address for Bcc -- must be SMTP address or resolvable
' to a name in the address book
strBcc = "someone@somewhere.dom"
Item.Subject = Item.Subject & " - sent by JM"
Set objRecip = Item.Recipients.Add(strBcc)
objRecip.Type = olBCC
If Not objRecip.Resolve Then
strMsg = "Could not resolve the Bcc recipient. " & _
"Do you want still to send the message?"
res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
"Could Not Resolve Bcc Recipient")
If res = vbNo Then
Cancel = True
End If
End If

Set objRecip = Nothing
End Sub[/vba]
If anyone could help, I'd be much obliged. Thanks

[Zack Barresse]

Hi there, welcome to the board!

Could you just set the old subject as a variable and change it as necessary? Perhaps you could use some variation of this...

[vba]Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objRecip As Recipient
Dim strMsg As String
Dim res As Integer
Dim strBcc As String
Dim strSubj As String

'///////////////////
Const strSentByAdd As String = " - sent by JM"
Const strSentByNon As String = "Sent by JM"
'///////////////////

On Error Resume Next

' #### USER OPTIONS ####
' address for Bcc -- must be SMTP address or resolvable
' to a name in the address book
strBcc = "someone@somewhere.dom"

'///////////////////
If Len(Item.Subject) > 0 Then
If InStr(1, Item.Subject, strSentByAdd, vbTextCompare) > 0 Then
strSubj = Left(Item.Subject, InStr(1, Item.Subject, strSentByAdd, vbTextCompare)) & strSentByAdd
Else
strSubj = Item.Subject & strSentByAdd
End If
Else
strSubj = strSentByNon
End If
Item.Subject = strSubj
'///////////////////

Set objRecip = Item.Recipients.Add(strBcc)
objRecip.Type = olBCC
If Not objRecip.Resolve Then
strMsg = "Could not resolve the Bcc recipient. " & _
"Do you want still to send the message?"
res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
"Could Not Resolve Bcc Recipient")
If res = vbNo Then
Cancel = True
End If
End If

End Sub[/vba]

HTH

[jamajam]

Hi Zack, thanks for your reply.

I've just tried this out and it seems to work so thank you very much. I would never have worked out how to do this so I'm really grateful.

I'm just going to test it out for a day or so, just to make sure there's no probs and then I'll add it to the other 2 machines.
I expect you're really busy but if you've got a spare 5 mins could you explain please how it works? I get that the VBTextCompare is doing some sort of comparison between the old subject and new subject but just can't quite understand fully what's going on.

Anyway, thanks once again

[Zack Barresse]

No problem, comments away...
[vba] '///////////////////////////////////////////////////////////////////////////////////////////////
'check the length of the subject, so if there is something there, the Len() will be greater
'than zero
If Len(Item.Subject) > 0 Then
'if there is currently a subject line, we need to know if there has been a "sent by" in
'it before, so we will check to see if it is IN the STRing of the current subject line.
If InStr(1, Item.Subject, strSentByAdd, vbTextCompare) > 0 Then
'this means the part we're looking for was found in the current subject line, in which
'case we will find the first instance of it and append our own, leaving out all the others
strSubj = Left(Item.Subject, InStr(1, Item.Subject, strSentByAdd, vbTextCompare)) & strSentByAdd
Else
'this means the part we're looking for was NOT found in the current subject line, in
'which case we will just append it to the current subject string
strSubj = Item.Subject & strSentByAdd
End If
Else
'The length of the subject is not greater than zero, meaning there is currently no subject,
'so we're either dealing with a new message or one that the subject was deleted from,
'in which case we will put our own string variable in there as so we know it has a subject
strSubj = strSentByNon
End If
'make the subject line our variable from above
Item.Subject = strSubj
'///////////////////////////////////////////////////////////////////////////////////////////////[/vba]
Hope this helps.