Outlook Macro warning when an email is being sent to multiple unintended recipients.

Actually, this might work a little better, since you want to show the email that matched.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'On the next line edit the address as desired.  Please enter it in all lowercase.'
    Const ADDRS_TO_WATCH_FOR = "someone1@company.com,someone2@company.com"
    Dim olkRec As Outlook.Recipient
    Dim strMatch As String
    If Item.Class = olMail Then
        For Each olkRec In Item.Recipients
            strMatch = FindInList(olkRec.Address, ADDRS_TO_WATCH_FOR)
            If strMatch <> "" Then
                If MsgBox("This message is addressed to " & strMatch & ".  Are you sure you want to send it?", vbQuestion + vbYesNo, "Confirm Send") = vbNo Then
                    Cancel = True
                End If
                Exit For
            End If
        Next
    End If
    Set olkRec = Nothing
End Sub

Private Function FindInList(strItem, strList) As String
    Dim strElement As String
    FindInList = ""
    If strItem = "" Or strList = "" Then
        Exit Function
    End If
    For Each strElement In Split(strList, ",")
        If LCase(strItem) = LCase(strElement) Then
            FindInList = strElement
            Exit Function
        End If
    Next
End Function

Select allOpen in new window

---

»bp

The first one worked, but I was just about to post what you mentioned, it didn't tell me what address in particular i was sending it to.

The second one I get a Compile Error:  For Each control variable must be Variant or Object.
This is on the beginning under the End Sub on the line:

Private Function FindInList(strItem, strList) As String

Yep, that's the ticket, awesome.  

Let me ask your thoughts on something else.  The issue we have is we have 2 people with the same first name, and their last name is different, but the first 4 letters are the same of the last name.

Could this be modified to instead of returning the email address, it would return a specified name or text?

For example, let's say the 2 email addresses I use are jmiller@email.com and jmilton@email.com for Jim Miller and Jim Milton.

When it checks, it would return, "Are you sure you want to send this to JIM MILLER?"  or
"Are you sure you want to send this to JIM MILTON?"

So it's a little more eye catching?

Additionally, I might edit the text to say "JIM MILLER with So and SO company".

That's doable, but would take a bit more work, probably double to triple the code so far.  To do that you would probably want to look the email address up in the local Contacts, and if not found perhaps in the Global Address List (assuming you are in an Exchange environment).

Or, if this list is pretty static and you just want to hard code the friendly names in the existing script, nothing fancy, that we could do pretty easy.

---

»bp

Yes Sir, this list is very static.  I'm only worried about 2 email address and hard coding the friendly names, or like I added to my previous comment, adding to the friendly static name with something more expansive like "Jim Miller with Miller & Associates" so there would be no way they could misread it.   :)

Woooo that works beautifully!  Thanks so much for your time and most importantly, that beautiful brain!

Incredible solution, more than I ever expected I'd get.  Thanks so much!

Great, and I'd be remiss if I didn't add at least a few comments for posterity...

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim olkRec As Outlook.Recipient
    Dim strMatch As String
    Dim arrWarnList()
    
    ' Array or email addresses to warn when sending to, with "friendly name" to display here
    arrWarnList = Array(Array("pward@company.com", "Pamela Ward"), _
                        Array("jwatson@company.com", "Justin Watson"), _
                        Array("rbennett@company.com", "Richard Bennett"))

    ' Make sure we have an email item
    If Item.Class = olMail Then
        ' Check each of the recipients
        For Each olkRec In Item.Recipients
            ' Check the list of emails to warn when sending to, put up wanring message for confirmation
            strMatch = FindInList(olkRec.Address, arrWarnList)
            If strMatch <> "" Then
                If MsgBox("This message is addressed to " & strMatch & ".  Are you sure you want to send it?", vbQuestion + vbYesNo, "Confirm Send") = vbNo Then
                    Cancel = True
                End If
                Exit For
            End If
        Next
    End If
    Set olkRec = Nothing
End Sub

Private Function FindInList(strItem As String, arrList()) As String
' Look for an email address in an array of addresses
' Each element of the array passed in itself a two elelement array,
' with the first element being the key (email address),
' and the second elelement being the returned data (friendly name)
    Dim strElement As Variant
    FindInList = ""
    If strItem = "" Then
        Exit Function
    End If
    For Each arrElement In arrList
        If LCase(strItem) = LCase(arrElement(0)) Then
            FindInList = arrElement(1)
            Exit Function
        End If
    Next
End Function

Select allOpen in new window

---

»bp

One last comment, this check it does against the email address isn't case sensitive is it?

No, it is not case sensitive, notice this line in the function, it converts both the email address from the outgoing email, and the email addresses in the list of exceptions to lower case before comparing them, making it a case insensitive compare.

If LCase(strItem) = LCase(arrElement(0)) Then

---

»bp