Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If (TypeOf Item Is MailItem) Then
Dim strMsg As String
Dim msgResult As Integer
Dim Myinput As Variant
Dim objMsg As Outlook.MailItem
Dim Store As String
Dim Store2 As String
Dim xAttachment As Attachment
Dim xFileName As String
Dim xInspector As Outlook.Inspector
Dim xDoc As Word.Document
Dim xWdSelection As Word.Selection
Dim Store3 As String
Dim Store4 As String
Dim Store5 As String
Dim Store6 As String
Dim i As String
Dim j As Integer
strMsg = "From Address: "
If Item.SenderEmailAddress <> Item.SentOnBehalfOfName Then
strMsg = strMsg & Item.SentOnBehalfOfName
End If
If Item.SentOnBehalfOfName = "" Then
strMsg = strMsg & Item.SendUsingAccount
Set objMsg = Application.ActiveInspector.CurrentItem
On Error Resume Next
For Each Recipient In objMsg.Recipients
If InStr(1, Recipient, "@") > 0 Then
msgResult = MsgBox("This is an external email contact:" & vbNewLine & vbNewLine & _
Recipient & vbNewLine & vbNewLine & "Please confirm do you still want to send this email?" & vbNewLine & vbNewLine, vbYesNo + vbDefaultButton2 + vbQuestion, "EXTERNAL EMAIL CONTACT")
If msgResult = vbNo Then
Cancel = True
Exit Sub
End If
End If
Next Recipient
Line:
If InStr(1, Item.To, "@") > 0 Then
Myinput = InputBox("Enter Plan Number", "Plan Number")
If Len(Myinput) <> 6 Then
MsgBox "Enter Six digit plan number"
GoTo Line
End If
Store = Myinput
If msgResult = vbNo Then
Cancel = True
Exit Sub
End If
Store2 = Item.Subject
If InStr(1, Store2, Store) = 0 Then
msgResult = MsgBox("Plan number is not matching with subject line:" & vbNewLine & vbNewLine & Item.Subject & vbNewLine & vbNewLine & _
"Please confirm do you still want to send this email?" & vbNewLine & vbNewLine, vbYesNo + vbDefaultButton2 + vbInformation, "Subject Line")
If msgResult = vbNo Then
Cancel = True
Exit Sub
End If
End If
If Item.Class = olMail Then
Set objMsg = Item
If objMsg.Attachments.Count > 0 Then
i = "image00"
j = 1
On Error Resume Next
Set objMsg = Outlook.ActiveInspector.CurrentItem
If objMsg.Attachments.Count = 0 Then
Exit Sub
End If
xFileName = ""
For Each xAttachment In objMsg.Attachments
If xFileName = "" Then
xFileName = " <" & xAttachment.FileName & "> "
Else
xFileName = xFileName & vbCrLf & " <" & xAttachment.FileName & "> "
End If
Store = Myinput
If InStr(1, xAttachment.FileName, Store) = 0 Then
If xAttachment.FileName = "image00" & j & ".png" Then
GoTo Line1
Else
msgResult = MsgBox("Plan number is not matching with the attachment name:" & vbNewLine & vbNewLine & xAttachment.FileName & vbNewLine & vbNewLine & _
"Please confirm do you still want to send this email?" & vbNewLine & vbNewLine, vbYesNo + vbDefaultButton2 + vbCritical, "Incorrect Attachment")
If msgResult = vbNo Then
Cancel = True
Exit Sub
End If
End If
End If
Line1:
j = j + 1
Next xAttachment
End If
End If
End If
If InStr(1, Item.To, "@") > 0 Then
MsgBox ("YOU CANNOT SEND THIS EMAIL")
Cancel = True
Exit Sub
Else
GoTo Line4
End If
ElseIf Item.SenderEmailAddress <> Item.SentOnBehalfOfName Then
Set objMsg = Application.ActiveInspector.CurrentItem
On Error Resume Next
For Each Recipient In objMsg.Recipients
If InStr(1, Recipient, "@") > 0 Then
Store4 = Right(Item.To, Len(Item.To) - InStr(1, Item.To, "@"))
Store5 = Left(Recipient, InStr(1, Recipient, "@"))
msgResult = MsgBox("This is an external email contact:" & vbNewLine & vbNewLine & _
Recipient & vbNewLine & vbNewLine & "Please confirm do you still want to send this email?" & vbNewLine & vbNewLine, vbYesNo + vbDefaultButton2 + vbQuestion, "EXTERNAL EMAIL CONTACT")
If msgResult = vbNo Then
Cancel = True
Exit Sub
End If
Line5:
Myinput = InputBox("Please enter the domain name for" & vbNewLine & vbNewLine & Store5, "Enter Domain Name")
Store6 = Store5 & Myinput
If UCase(Store6) <> UCase(Recipient) Then
MsgBox "Domain name did not matched for:" & vbNewLine & vbNewLine & Recipient
Cancel = True
Exit Sub
End If
End If
Next Recipient
Line2:
If InStr(1, Item.To, "@") > 0 Then
Myinput = InputBox("Enter Plan Number", "Plan Number")
If Len(Myinput) <> 6 Then
MsgBox "Enter Six digit plan number"
GoTo Line2
End If
Store = Myinput
If msgResult = vbNo Then
Cancel = True
Exit Sub
End If
Store2 = Item.Subject
If InStr(1, Store2, Store) = 0 Then
msgResult = MsgBox("Plan number is not matching with subject line:" & vbNewLine & vbNewLine & Item.Subject & vbNewLine & vbNewLine & _
"Please confirm do you still want to send this email?" & vbNewLine & vbNewLine, vbYesNo + vbDefaultButton2 + vbInformation, "Subject Line")
If msgResult = vbNo Then
Cancel = True
Exit Sub
End If
End If
If Item.Class = olMail Then
Set objMsg = Item
If objMsg.Attachments.Count > 0 Then
i = "image00"
j = 1
On Error Resume Next
Set objMsg = Outlook.ActiveInspector.CurrentItem
If objMsg.Attachments.Count = 0 Then
Exit Sub
End If
xFileName = ""
For Each xAttachment In objMsg.Attachments
If xFileName = "" Then
xFileName = " <" & xAttachment.FileName & "> "
Else
xFileName = xFileName & vbCrLf & " <" & xAttachment.FileName & "> "
End If
Store = Myinput
If InStr(1, xAttachment.FileName, Store) = 0 Then
If xAttachment.FileName = "image00" & j & ".png" Then
GoTo Line3
Else
msgResult = MsgBox("Plan number is not matching with the attachment name:" & vbNewLine & vbNewLine & xAttachment.FileName & vbNewLine & vbNewLine & _
"Please confirm do you still want to send this email?" & vbNewLine & vbNewLine, vbYesNo + vbDefaultButton2 + vbCritical, "Incorrect Attachment")
If msgResult = vbNo Then
Cancel = True
Exit Sub
End If
End If
End If
Line3:
j = j + 1
Next xAttachment
End If
End If
If Item.SentOnBehalfOfName = "SHR-US-Corporate TPA Plan Consultants" Then
If Left$(Store, 1) = "5" Then
MsgBox ("This is a BUNDLED Plan" & vbNewLine & vbNewLine & "Please send the email from BUNDLED shared mailbox")
Cancel = True
Exit Sub
ElseIf Left$(Store, 1) = "7" Then
MsgBox (" This is a BUNDLED Plan" & vbNewLine & vbNewLine & "Please send the email from BUNDLED shared mailbox")
Cancel = True
Exit Sub
Else
GoTo Line4:
End If
End If
If Item.SentOnBehalfOfName = "SHR-US-Corporate Bundled Plan Consultants" Then
If Left$(Store, 1) = "5" Then
GoTo Line4:
ElseIf Left$(Store, 1) = "7" Then
GoTo Line4:
ElseIf Left$(Store, 1) = "6" Then
GoTo Line4:
Else
MsgBox ("This is a TPA Plan" & vbNewLine & vbNewLine & "Please send the email from TPA shared mailbox")
Cancel = True
Exit Sub
End If
End If
End If
Line4:
strMsg = strMsg & vbNewLine & vbNewLine & " To Address: " & Item.To
msgResult = MsgBox(strMsg, vbOKCancel + vbDefaultButton2 + vbCritical, _
"Account Check")
If msgResult = vbCancel Then
Cancel = True
Exit Sub
End If
End If
End If
End Sub