Outlook vba code search keywords and give warning before sending email

[tjesch]

I would like to have a warning messagebox if the email body contains specific words before sending an email in outlook.
I have no clue where to start. Any advice is welcome please.

 

[Andrzejek]

This place could be a good starting point....


---- Andy

There is a great need for a sarcasm font.

 

[tjesch]

http://www.snb-vba.eu/VBA_Outlook_external_en.html#L_15.4.1

 

[MajP]

If you are doing this just for yourself and a few words, you could do something like this. Worked for me. But you will have to lighten up your macro security settings in trust center.
In the ThisOutlookSeesion module

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
 Dim FoundWords As String
 Dim Body As String
 Dim MailItem As Outlook.MailItem
 Dim BadWords As Collection
 Dim i As Integer
 If TypeOf Item Is Outlook.MailItem Then
   Set MailItem = Item
   Body = MailItem.Body
   Set BadWords = GetWords
   For i = 1 To GetWords.Count
     If InStr(Body, GetWords(i)) <> 0 Then
       FoundWords = FoundWords & ", " & GetWords(i)
     End If
   Next i
   If Not FoundWords = "" Then
     prompt = "Are you sure you want to send " & Item.Subject & "? It contains: " & FoundWords
     If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
       Cancel = True
     End If
   End If
  End If
End Sub

Public Function GetWords() As Collection
   Dim colWords As New Collection
   'add all your words here
   colWords.Add "Dog"
   colWords.Add "Cat"
   colWords.Add "Money"
   colWords.Add "!@#$"
   '....
   Set GetWords = colWords
End Function