Prevent external emails from Corporate account - Outlook 2010

Sometimes we unknowingly or by mistake we may send official/important emails to our personal email ids (or other external email ids). To prevent those instance(s), we can make use of VBA from MS-Outlook 2010. 

Technically, below event triggers while we click on Send button (of course Alt + S :P)

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

If Item.Class <> olMail Then Exit Sub

Dim sCompanyDomain As String: sCompanyDomain = "companydomain.com"

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

On Error Resume Next
Dim oMail As MailItem: Set oMail = Item
Dim oRecipients As Recipients: Set oRecipients = oMail.Recipients
Dim bDisplayMsgBox As Boolean: bDisplayMsgBox = False

Dim sExternalAddresses As String
Dim oRecipient As Recipient

For Each oRecipient In oRecipients

    Dim oProperties As PropertyAccessor: Set oProperties = oRecipient.PropertyAccessor
    Dim smtpAddress As String: smtpAddress = oProperties.GetProperty(PidTagSmtpAddress)

    Debug.Print smtpAddress

    If (Len(smtpAddress) >= Len(sCompanyDomain)) Then
        If (Right(LCase(smtpAddress), Len(sCompanyDomain)) <> sCompanyDomain) Then

            ' external address found
            If (sExternalAddresses = "") Then
                sExternalAddresses = smtpAddress
            Else
                sExternalAddresses = sExternalAddresses & ", " & smtpAddress
            End If

            bDisplayMsgBox = True
        End If
    End If
Next

If (bDisplayMsgBox) Then
    Dim iAnswer As Integer
    iAnswer = MsgBox("You are about to send this email externally to " & sExternalAddresses & vbCr & vbCr & "Do you want to continue?", vbExclamation + vbYesNo, "External Email Check - Srinivas G")

    If (iAnswer = vbNo) Then
        Cancel = True
    End If

End If

End Sub

http://stackoverflow.com/questions/5596835/conditionally-prevent-outlook-from-sending-email-based-on-from-and-recipient-add