We help IT Professionals succeed at work.

Outlook 2007 -- Small Macro Change

finance_teacher
on
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  Answer = MsgBox("Is this email confidential?", vbYesNoCancel, "Confidential")
  Select Case Answer
    Case vbYes
      If Item.BodyFormat = olFormatHTML Then
        Item.HTMLBody = Replace(Item.HTMLBody, "</body></html>", "This is a confidential email, do not ....</body></html>")
      Else
        Item.Body = Item.Body & vbCrLf & "This is a confidential email, do not ...."
    End If
    Case vbCancel
      Cancel = True
  End Select
  Application_ItemSend2 Item, Cancel
End Sub
Comment
Watch Question

Author

Commented:
How can i change the above so it only prompts on messages sent to non "@test.com" users ?
Neil RussellTechnical Development Lead

Commented:
Unfortunately it is NO SMALL change. Recipients is a collection, because you can have many many recipients to an email message.

I dont have time to recode for you but if you know VBA then this link withh tell you more or less everything you need to know.

http://www.jpsoftwaretech.com/blog/2010/06/working-with-the-outlook-recipients-collection-in-vba/

Top Expert 2011
Commented:
Try the following, obviously edit @test.com to the domain that interests you.  I have assumed that the domain is NOT an internal exchange address but other than that it ought to work fine.

Chris
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim recip As Recipient
Dim bolDomain As Boolean
Dim answer As Variant

    For Each recip In Item.Recipients
        If InStr(1, recip.Address, "@test.com", vbTextCompare) > 0 Then bolDomain = True
    Next
    If bolDomain Then
        answer = MsgBox("Is this email confidential?", vbYesNoCancel, "Confidential")
        Select Case answer
          Case vbYes
            If Item.BodyFormat = olFormatHTML Then
              Item.HTMLBody = Replace(Item.HTMLBody, "</body></html>", "This is a confidential email, do not ....</body></html>")
            Else
              Item.Body = Item.Body & vbCrLf & "This is a confidential email, do not ...."
          End If
          Case vbCancel
            Cancel = True
        End Select
        Application_ItemSend2 Item, Cancel
    End If
End Sub

Open in new window