Delete text from message before sending to specific address

[DanTGK1]

Hi

I am trying to write a macro that deletes certain text if I am replying to specific address.

The signature from the sender contains phone numbers that our mail system thinks is a credit card number and therefore blocks it.

This is what I have tried but it errors and I think it is because I have the 'Recipient' bit wrong. Probably doesn't exist but I cannot find the equivalent.

I hope that it will check 'cc' an 'to' lines.



Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Set myItem = Application.CreateItem(olMailItem)
If myItem.Recipient = "mail address here" Then
myItem.Body = Replace(outMailItem.Body, "Phone : +44 (0) 123 45 6789" & _
vbNewLine & "Mobile : +44 (0) 9 8765 4321", "")
End If
End Sub


Thanks

[gmayor]

Open a message that contains the information you want to remove. Press CTRL+SHIFT+8 (CTRL+*) which will toggle the display to show the line end characters e.g.

13163

If the character is the paragraph break character ¶ then use the following code. If it is the line break character as shown at at the end of the first row of symbols then replace VbCr in strFind with VbLf
Put the code in the ThisOutlookSession module. It will look in the body of every message you send for the offending text and remove it.
The process should be fast enough for you to use it for all messages.



Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Const strFind As String = "Phone : +44 (0) 123 45 6789" & _
vbCr & "Mobile : +44 (0) 9 8765 4321"
With Item
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
With oRng.Find
Do While .Execute(FindText:=strFind)
oRng.Text = ""
Loop
End With
.Save
End With
lbl_Exit:
Exit Sub
End Sub

[DanTGK1]

Hi

It is as you have pictured but the text is not being removed. I am on Outlook 2013 if that makes a difference?

[gmayor]

There is no room for error in the search strings. It has to be EXACTLY as it appears in the message. The Outlook version shouldn't matter. If you want to forward a message to me (with the problem text) to check, then send it to supportATgmayor.com (with your username in the subject line).

[skatonni]

Work with Item from "ByVal Item As Object" rather than fictitious objects.

Try Item.To for a string


Private Sub Application_ItemSend(ByVal Item As Object, cancel As Boolean)
If Item.To = "mail address here" Then
Item.body = Replace(Item.body, "Phone : +44 (0) 123 45 6789" & _
vbNewLine & "Mobile : +44 (0) 9 8765 4321", "")
End If
End Sub