Code to check if subject contains the receipt email address ( Validation)

[aravindhan_3]

Hi,

some of my team members sends out email to outside my office email address, domain address is @Arvind.com

just to avoid this, i have the below code which checks and prompts whether the user before then send.



Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Dim prompt As String
Dim strMsg As String


Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"


Set recips = Item.Recipients
For Each recip In recips
Set pa = recip.PropertyAccessor
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@in.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@uk.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@ie.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@Arvind.ie") = 0 Then
strMsg = strMsg & " " & pa.GetProperty(PR_SMTP_ADDRESS) & vbNewLine
End If
End If
End If
End If
Next
For Each recip In recips
Set pa = recip.PropertyAccessor
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@in.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@uk.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@ie.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@Arvind.ie") = 0 Then
prompt = "This email will be sent outside of mydomain.com to:" & vbNewLine & strMsg & "Do you want to proceed?"
If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
Exit Sub
End If
End If
End If
End If
End If

Next
End Su

but most of the time they have to send to outsiders as well, but they have to mention the name in subject line, and they miss it always. I would like to add one more condition to this, in case any of them sending an email to outsiders, they have to mention the domain name in subject line.

eg if any of them sending email to xxxx@vbaexpress.com
then they have to mention in the subject line - vbaexpress ( domain name)
if they miss it, a prompt message should come

Can anyone help with this

Regards
Arvind

[excelliot]

Hi use below code:



Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Dim prompt As String
Dim strMsg As String
Dim domain As String


Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"


Set recips = Item.Recipients
For Each recip In recips
Set pa = recip.PropertyAccessor
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@in.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@uk.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@ie.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@Arvind.ie") = 0 Then
domain = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
domain = Split(domain, "@")(1)
domain = Replace(domain, "." & Right(domain, (Len(domain) - InStrRev(domain, "."))), "")
If InStr(Item.Subject, domain) = 0 Then
strMsg = strMsg & " " & pa.GetProperty(PR_SMTP_ADDRESS) & vbNewLine
End If
End If
End If
End If
End If
Next

If strMsg <> "" Then
prompt = "This email will be sent outside of mydomain.com to:" & vbNewLine & strMsg & "Do you want to proceed?"
If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
Exit Sub
End If
End If
End Sub


So now you will prompted only if you miss domain name in Subject line..

Cheers!!

[aravindhan_3]

Hi,

Thanks for the code, this works, but its giving only one warning message,
can we change this to
1. If the to address is outside domain it has to give a warning "You are sending to outside domain do you want to proceed" anyways irrespective whether subject is entered or not
2. when click yes to proceed, then check if the subject contain the domain name, if its already there, send message.
If no,give a warning to edit the subject

Regards
Arvind

[excelliot]

Ok, check this..




Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Dim prompt As String
Dim strMsg As String, strMsg2 As String
Dim domain As String


Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

Set recips = Item.Recipients
For Each recip In recips
Set pa = recip.PropertyAccessor
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@in.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@uk.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@ie.Arvind.com") = 0 Then
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@Arvind.ie") = 0 Then
strMsg = strMsg & " " & pa.GetProperty(PR_SMTP_ADDRESS) & vbNewLine
domain = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
domain = Split(domain, "@")(1)
domain = Replace(domain, "." & Right(domain, (Len(domain) - InStrRev(domain, "."))), "")
If InStr(Item.Subject, domain) = 0 Then
strMsg2 = strMsg2 & " " & domain & vbNewLine
End If
End If
End If
End If
End If
Next



If strMsg <> "" Then
prompt = "This email will be sent outside of mydomain.com to:" & vbNewLine & strMsg & "Do you want to proceed?"
If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
Exit Sub
End If
End If

If strMsg2 <> "" Then
prompt = "This email does contain external domain name " & vbNewLine & "Kindly add domain name : " & vbNewLine & strMsg2 & vbNewLine & "in subject line to send this email."
If MsgBox(prompt, vbOKOnly + vbMsgBoxSetForeground, "Check Domain NAme") = vbOK Then
Cancel = True
Exit Sub
End If
End If

End Sub



Cheers!!

[aravindhan_3]

Great!.. this worked.

thanks a lot :)

[excelliot]

Cool, Cheeers!!

[aravindhan_3]

Hi,

just realized one more problem, this one works perfectly fine when i sent individual emails to my suppliers.

some times i have to send a reminder to all the suppliers at one shot, in that case its asking me to enter all the domain names in subject? is there any better way to avoid this? or any other option that we do?
like if there are more than 1 domain names in to address, there should be any one of the works " Reminder or followup or note" in subject?
THanks