I pick up interesting problems looking for solutions on various forums, such as this one.

Can I create an Outlook Rule that will keep me from sending an email to the wrong address? The reason: I have various email addresses. On occasion, I intend to send a message to my own address and use the wrong address instead, sending an email to the same wrong person more than once.

You can't use a rule to protect you from yourself but if you realize it as soon as you hit send, you can use a rule to delay mail by a minute or two, to give you time to recover the message and change the address. I have more information at Defer delivery in Outlook. You could also disable autocomplete, since it is the main cause of this problem, but because its a very good time saver most of the time, a macro is better.

Alternately, you can use macros to help get the address right. Since the problem is likely due to your selecting the wrong address as you type in the To field, using macros to create and address messages will reduce some, if not all of the problems. You can also use a macro to check outgoing messages for an address.

Choose or check for a sending account using Categories assigned to contact: "Assign an Email Account to an Outlook Contact"

Forward selected message to specific address

This macro solves the user's immediate problem, forwarding a message to the wrong address.

Create a macro for your address and assign the macro to a toolbar or ribbon button. Place the button(s) next to the Forward button to help you remember. You'll need one macro & button for each address you forward messages to.

Public Sub ForwardtoMe()
Dim oMail As Outlook.MailItem

Set oMail = Application.ActiveExplorer.Selection(1).Forward
oMail.Recipients.Add ("alias@domain.com")
    oMail.Display
  
End Sub

Check messages you send

This macro checks messages for one specific display name and if it finds a match, allows you to cancel the send. On Error Resume Next allows it to work with meetings or task requests, otherwise it kicks up an error message. Note: other macros on this page check the SMTP address and are recommended over this one.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    
On Error Resume Next
 ' use lower case for the address 
 ' LCase converts all addresses in the To field to lower case
If InStr(LCase(Item.To), "bad@address.com") Then
      Prompt$ = "You sending this to " & Item.To & ". Are you sure you want to send it?"
       If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
         Cancel = True
       End If
  End If
    
End Sub

A slightly different version of the above macro checks messages you send for one of several addresses. If the address on the message is not one in the list (or there are multiple addresses in the list), it will ask if you really want to send.

While not the best option in my opinion, because it basically asks for confirmation every time you send, it may be a good solution in some cases.

To use, add your addresses to the Case line. This macro needs to be added to ThisOutlookSession to work.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    On Error Resume Next
   Select Case LCase(Item.To)
    Case "alias@domain.com", "alias2@domain3.com", "alias3@domain3.com"
        Item.Send
    Case Else
      Prompt$ = "You are not sending this to " & Item.To & ". Are you sure you want to send the Mail?"
       If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
         Cancel = True
       End If
    
    End Select
    
End Sub

Check addresses in the To, CC, or BCC field using the Recipient Collection

This variation of the code checks all addresses in the recipient collection against the "bad address".

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
     
  Dim Recipients As Outlook.Recipients
  Dim recip As Outlook.Recipient
  Dim i
  Dim prompt As String
  
On Error Resume Next
 ' use lower case for the address
 ' LCase converts all addresses in the To field to lower case
 
 Set Recipients = Item.Recipients
  For i = Recipients.Count To 1 Step -1
    Set recip = Recipients.Item(i)
    
 Debug.Print recip.Address
 If InStr(LCase(recip.Address), "bad@domain.com") Then 
      prompt$ = "You sending this to this to " & Item.To & ". Are you sure you want to send it?"
       If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
         Cancel = True
       End If
  End If

Next i
 
     
End Sub

Check for multiple domains

This is Keith's code sample . Use it to check if the message is being sent to specific domains. With the simple removal of Case Else line, you can convert it from warning for all but the listed domains to warning for only those domains.

In this example, I'm using InStrRev function to get the position of the @ symbol to use when determining the length of domain, which allows me to use the Right function and Select Case. InStrRev looks for the designated string beginning on the right, not left as Instr does.

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 Address As String
 Dim lLen

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
 
 Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
 lLen = Len(Address) - InStrRev(Address, "@")

 Select Case Right(Address, lLen)
    Case "cdolive.com", "slipstick.com", "outlookmvp.com"      
         
    Case Else ' remove case else line to be warned when sending to the addresses
     strMsg = strMsg & " " & Address & vbNewLine
 End Select
 Next

If strMsg <> "" Then
 prompt = "This email will be sent outside of the company to:" & vbNewLine & strMsg & vbNewLine & "Please check recipient address." & vbNewLine & vbNewLine & "Do you still wish to send?"
 If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
 Cancel = True
 End If
 End If

End Sub

Check for different domains

Frank wanted to check to see if a message was being sent to two different domains and if so, trigger a warning. (This code skips addresses in the sending account's domain.)

To do this, we need to create a string containing the message recipients then split it into an array. We compare the members of the array and if any two don't match, trigger the warning message. If you say Yes the first time the warning comes up, the macro exits and the message is sent. If you want to continue checking addresses after clicking Yes, remove the Exit Sub after the prompt.

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 Address As String
 Dim lLen
 Dim arr
 Dim strMyDomain
 Dim userAddress
 
Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
 
' non-exchange
' userAddress = Session.CurrentUser.Address
' use for exchange accounts
userAddress = Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress
lLen = Len(userAddress) - InStrRev(userAddress , "@")
strMyDomain = Right(userAddress, lLen)

Set recips = Item.Recipients
 For Each recip In recips
 Set pa = recip.propertyAccessor
  
Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
 lLen = Len(Address) - InStrRev(Address, "@")
str1 = Right(Address, lLen)

If str1 <> strMyDomain Then
strRecip = str1 & "," & strRecip
End If
Next

 arr = Split(strRecip, ",")

' need to subtract one because string ends with a ,
For i = LBound(arr) To UBound(arr) - 1 
   For j = LBound(arr) To i
    If arr(i) <> arr(j) Then

prompt = "This email is being sent to people at " & arr(i) & " and " & arr(j) & " Do you still wish to send?"
 If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
 Cancel = True
 End If
Exit Sub ' stops checking for matches
  
End If
Next j
 
Next
 
End Sub

Check for messages to Internal and External addresses

This version of the code will check for the presence of Internal and External addresses and if both are found, the warning message comes up. If the message is sent only to internal addresses or only to external addresses, the message is sent.

If str1 = strMyDomain Then internal = 1
If str1 <> strMyDomain Then external = 1
If internal + external = 2 Then

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 Address As String
 Dim lLen
 Dim strMyDomain
 Dim internal As Long
 Dim external As Long
  
Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
  
' non-exchange
' userAddress = Session.CurrentUser.Address
' use for exchange accounts
userAddress = Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress
lLen = Len(userAddress) - InStrRev(userAddress, "@")
strMyDomain = Right(userAddress, lLen)
 
Set recips = Item.Recipients
 For Each recip In recips
 Set pa = recip.propertyAccessor
   
Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
 lLen = Len(Address) - InStrRev(Address, "@")
str1 = Right(Address, lLen)
 
  If str1 = strMyDomain Then internal = 1
  If str1 <> strMyDomain Then external = 1
Next
 
 If internal + external = 2 Then
prompt = "This email is being sent to Internal and External addresses. Do you still wish to send?"
 
 If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
    Cancel = True
 End If
   
End If
  
End Sub

Check new messages you send

A user with three accounts in his profile wanted to be reminded which email account was sending the message, but because Outlook always sends replies and forwards using the account that downloaded the message, he only want to check new messages.

The result is this code sample which checks new messages on send while skipping replies and forwards. It looks for RE: or FW: as the first 3 characters in the subject and skips the dialog if they are found. By using LCase, it will pick up RE:, Re: or re:.

To check all messages sent from all accounts except your default email account, replace the IF line with this:

If Not Item.SendUsingAccount = "my-default-account@domain.com" Then

To check only for a specific email account, use this:

If Item.SendUsingAccount = "alias-I-don't-use@domain.com" Then

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

On Error Resume Next

If Not Left(LCase(Item.Subject), 3) = "re:" And Not Left(LCase(Item.Subject), 3) = "fw:" Then
      prompt$ = "You sending this from " & Item.SendUsingAccount & ". Are you sure you want to send it?"
       If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Sending Account") = vbNo Then
         Cancel = True
       End If
End If

End Sub

Video tutorial: How to use the ItemSend macros

How to use VBA code samples

To use either of these macros, open the VBA Editor using Alt+F11. Expand Project1.

The macro that checks addresses when you send messages needs to be in ThisOutlookSession.

The macro that forwards mail to a specific address can go into a separate Module. To add a module, right click on Project1 and choose Insert > Module.

Paste the code into the editor.

Change the addresses in the sample code to your own address.

The macro that checks address will run when you send messages.

To create buttons for the forward macro:

In Outlook 2010 and above:

1. Go to File, Options, and choose Customize Ribbon.
2. Add a New Group to the list on the right side then Add the macro to the new group.
   
3. Select Macros in Choose Commands from.

In Outlook 2007 and older:

1. Right click in the toolbar area, choose Customize.
2. Switch to the Commands tab.
3. Select Macros under Categories.
   
4. Drag the macro to anywhere on the Toolbar.

If you would rather not use a macro, the following add-ins can check messages before sending.