Outlook – use Outlook’s rules to automatically send an email (not forward an email) each time a new message arrives

I've seen variations of this question before, but can't find any now so figured I'd ask and answer it.

I wrote this VBa to resolve the issue! Now when I click send, if I'm not sending from a specific account it will look through the 'send to list' and then prompt me to either cancel or continue. This means it's wonderfully non-invasive! If I click cancel (do not send), the email remains open and unchanged.

Open the developer ribbon, open Visual Basic. Open the 'ThisOutlookSession' and paste in the following code

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

Dim oMail As MailItem
  Set oMail = Item

  Dim shouldSend As Boolean
  shouldSend = ShouldSendEmailFromBusinessAccount(oMail)
If Not (shouldSend) Then
    MSG1 = MsgBox("Are you sure you want to send this from the account you're using?", vbYesNo, "Are you sure?")
End If

If MSG1 = vbNo Then
    Cancel = True
End If

'Cancel = True

End Sub

Private Function ShouldSendEmailFromBusinessAccount(ByVal oMail As MailItem) As Boolean

    ShouldSendEmail = True

 'Set the recipients domains/email addresses you want to check.
    Dim sendToEmails(0 To 2) As String
    sendToEmails(0) = "@domain.co.uk" ' block a domain by TLD
    sendToEmails(1) = "domiain2" ' block an entire domain
    sendToEmails(2) = "person@domain.com" ' block a person



'The only account you want to send emails to
    Dim theAccountsToSendEmailsFrom(0 To 0) As String
    theAccountsToSendEmailsFrom(0) = "dave@business.co.uk"

    Dim recCount As Integer
    Dim myRec As Outlook.Recipient
    Dim mySender As String

    mySender = oMail.SendUsingAccount

    For a = 0 To UBound(theAccountsToSendEmailsFrom)

    theAccountToSendEmailsFrom = theAccountsToSendEmailsFrom(a) ' note, one is plural

        If (InStr(mySender, theAccountToSendEmailsFrom) = 0) Then

            recCount = oMail.Recipients.Count
            For i = 1 To recCount

                Set myRec = oMail.Recipients(i)
                myAddress = myRec.Address

                For j = 0 To UBound(sendToEmails)
                    If (InStr(LCase(myAddress), LCase(sendToEmails(j)))) Then
                        MsgBox ("Ooops, you are going to send to: " & sendToEmails(j) & " from " & mySender)
                        ShouldSendEmail = False
                        Exit For
                    End If
                Next

            Next
        End If

    Next

    ShouldSendEmailFromBusinessAccount = ShouldSendEmail

End Function

Since I only want to send to the domains from my work account, if I try to send from any other, I get:

Otherwise, it will just send as normal.

The above code will check every outgoing email address! This means it will check the To, CC and BCC... As soon as it finds a single recipient which matches, it will then show the Prompt asking if you want to send or not.