Public myResult As Long

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
On Error GoTo errhandler
    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set recips = Item.Recipients
    Dim myMailToSend As MailItem
    Dim regx As Object
    Dim s As String
    Dim bod As String
    Dim strMsg As String
    Dim nResponse As String
    Dim atch As String
    Dim attc As String
    Dim atchCount As Long
    myResult = 0
  
'=====================================================================================
'First let's see if the email is going to someone outside of the IRS.  If going only to irs.gov, exit the sub & send the email.
    For Each recip In recips
        Set pa = recip.PropertyAccessor
        If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@irs.gov") = 0 Then
        Else
        Exit Sub
        End If
    Next

'=====================================================================================
'Now that we know the email is going outside the IRS, make sure the body doesn't contain a TIN
    Const sPat As String = "\b\d{3}[\W]\d{2}[\W]\d{4}|\b\d{9}$|\b\d{2}[\W]\d{7}|\b\d{16}|\b\d{4}[\W]\d{4}[\W]\d{4}[\W]\d{4}"
    'Old string without CC numbers was: "\b\d{3}[\D]\d{2}[\D]\d{4}\b|\b\d{9}|\b\d{2}[\D]\d{7}\b"
    Set myMailToSend = Item
    Set regx = CreateObject("vbscript.regexp")
    regx.Pattern = sPat
    s = myMailToSend.Body & " " & myMailToSend.Subject
    If regx.test(s) = True Then
        strMsg = "The message appears to contain PII  " & _
            "Do you want to encrypt it?"
        nResponse = MsgBox(strMsg, vbExclamation + vbYesNo, _
                                            "Check Sensitive Information")
                If nResponse = vbYes Then
                    myResult = 1
                    GoTo FoundUnsecured
                Else
                End If
End If
'=====================================================================================
'And, now we check for attachments
    If Item.Attachments.Count = 0 Then 'cool, no attachments
        Else 'make sure the attachment is secure
        For atchCount = 1 To myMailToSend.Attachments.Count
'Make sure the attachment is not one you already secured.  All the secured files will be named "protectedfiles"
           attc = myMailToSend.Attachments.Item(atchCount).DisplayName '= "protectedfiles.zip" Then Exit Sub ' or .Filename
           If Not attc = "protectedfiles.zip" Then
        strMsg = "The message has attachments that have not been checked for PII.  " & _
            "Do you want to encrypt them before sending?"
        nResponse = MsgBox(strMsg, vbExclamation + vbYesNo, _
                                            "Check Sensitive Information")
                If nResponse = vbYes Then
                   myResult = myResult + 1
                   GoTo FoundUnsecured
                Else
                End If
           End If

        Next atchCount
    End If
FoundUnsecured:
If myResult = 0 Then
Cancel = False
Exit Sub
Else
CheckExchangeStatus
End If
''=====================================================================================
'Ready to send?
        strMsg = "The message has been encrypted.  " & _
            "A text file has been created to store the password in your documents folder " & _
            "The file name is the 'person you sent to, date and time'." & vbCrLf & vbCrLf & _
            "Send the message now?"

        nResponse = MsgBox(strMsg, vbExclamation + vbYesNo, _
                                            "Check Sensitive Information")
                If nResponse = vbYes Then
                Cancel = False
                Else
                Cancel = True
                End If

Exit Sub
errhandler:
MsgBox "Encountered an error (#" & Err.Number & ", " & Err.Description & ").  Exiting back to message"
Cancel = True

End Sub