Last reviewed on February 15, 2015   —  119 Comments

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.

Forward selected message to specific address

Create a macro for you 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 address and if it finds the address, 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.

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)
    
 If InStr(LCase(recip), "bad@address.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 checks 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 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 or Outlook 2013:
Create a macro button

  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:

Customize toolbar

  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.


Comments

  1. david says

    Hi Diane

    Am trying the code to warn before sending, but it is not working (no warning). I do have another rule in place to defer by 1 minute, would this be interfering?

  2. Rizu says

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) If InStr(LCase(Item.To), "bad@address.com") Then Prompt$ = "You sending this to bad@address.com. 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

    This code is not working. I am using Outlook 2010

  3. Rizu says

    Yes, security is low.

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    If InStr(LCase(Item.To), "M.Rizwan@domain.com") Then
    Prompt$ = "You sending this to M.Rizwan@domain.com. 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

    Please suggest why this is not working ? Thanks a lot in advance

  4. Rizu says

    Yes Macro security is Low?

    However I have noticed that Item. To is taken as string instead of mail object. Please can you help on this.

    • Diane Poremsky says

      Do you get any error messages?

      Addresses will be added as a string, but Outlook will resolve it before sending. If you insert more than one address, you need to separate them using semi-colon. If you use a name instead of any address, you need to have a contact to resolve the name to (same as if you'd type the name in the To field yourself.)

  5. Rizu says

    I am not getting any error messages. The Item.To, The To should turn blue in the code right ? its looking black only.

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    If InStr(LCase(Item.To), "M.Rizwan@domain.com") Then
    Prompt$ = "You sending this to M.Rizwan@domain.com 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

  6. Rizu says

    I am not getting any error messages. I am using only one Email Id. The Item. To, The To should turn to blue in the code right ? it is black only

    • Diane Poremsky says

      In this code, no, it's blue online because of the syntax highlighter I use. There is definitely something wrong with your code sample. :) Or it hates your address. Oh, the code is checking for lower case - the address string is mixed case.

  7. Rizu says

    Thanks a million !!! its working fine. Just one more clarification if I put a shared INbox email id , then again its not working. Any suggestion on this ? Sorry to disturb you again and again.

    • Diane Poremsky says

      Don't worry, you won't win the "ask the most questions in the shortest time period" award. :)

      Try using the display name. I may need to do a little tweaking for it to work with Exchange addresses because they don't use a smtp address.

  8. Rizu says

    LOL!! Yeah its working with the display name. Thanks a lot for your valuable time. I will email you my whole code actually this code is part of it. Please I want your feedback and suggestions.

  9. Alan Chitty says

    Hi i have tried this and works great .. how do i change so that it will only alert me when i send messages to addresses outside my domain... i tried *@mydomain but this does not work

    many thanks Alan

    • Diane Poremsky says

      If your domain is using Exchange server, the smtp address is not used, so that format won't work. This format should work for all internet addresses -

      If InStr(Item.To, "@") Then

      if you aren't using exchange, use something like this (I didn't test it so it might not be the correct format - basically, you need to check to see if it's not your domain):

      If Not InStr(Item.To, "@mydomain.com") Then

  10. Neil Harding says

    Great code for checking recipients in Outlook 2003 although I am experiencing a problem with Word not responding after I have sent an email. When I send a mail and confirm that I want to send it using the code, the email goes fine but when I switch back to Word 2003 none of the buttons or menus respond until I click outside of Word and then back in Word. any ideas please?

  11. Ryan says

    Hello,

    Iv altered the script a little to fit my need. How ever I'm not sure how to get it to work with emails using mixed case emails. Any feedback on that?

    • Diane Poremsky says

      if you want to match either ThisCase or thiscase, you'd use LCase - as in LCAse(Item.To) and enter the keywords in lower case.

      if LCase(item.subject) = "word" will match Word, WORD, wOrD etc.

  12. Ryan says

    Hey sorry I'm a bit new at this so I'm a little confused. Here is what I have so far.

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    If InStr((Item.To), "Fake Email(Display name)") Then
    Prompt$ = "This email is for a High Importance Client. Please double check Circuit ID, BPSO, and TX before sending." & Chr(13) & "" & Chr(13) & "EG. 17418CGCG; MTFS-134-L10" & Chr(13) & "" & Chr(13) & " BPSO 4824"
    If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
    Cancel = True
    End If
    End If

    End Sub

    This seems to work if I just put in the display name. Now I have found that when this script is on it fails when i try to send out meeting request and asks to debug.

  13. Ryan says

    Hey Diane! I think I have the addressing working for me. Whats really confusing me is its interupting When I send meeting requets now. Its asking for a debug. This is what I have.
    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    If InStr((Item.To), "Change Control") Then
    Prompt$ = "This email is for a High Importance Client. Please double check Circuit ID, BPSO, and TX before sending." & Chr(13) & "" & Chr(13) & "EG. 17418CGCG; MTFS-134-L10" & Chr(13) & "" & Chr(13) & " BPSO 4824"
    If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
    Cancel = True
    End If
    End If
    End Sub

    • Diane Poremsky says

      What line is highlighted in yellow when debug comes up? What does the error message say?

  14. Ryan says

    It says Run-time error 438
    Object doesn't support this property or method

    Then it highlights: If InStr((Item.To), "Change Control") Then

    • Diane Poremsky says

      I can't repro it - it works perfect here, no errors. Test it with a different name in the To field and see if you still get the error.

  15. Ryan says

    Yeah no change when I alter the name. All other email functions work normaly and the script works but when I send meeting requests it produces debug.

    Is there maybe a diffrent way of writing it to query a specific word?

    • Diane Poremsky says

      i wonder if its because you are using display names... I'll try and test it tonight.

  16. Nathan says

    Hi, the macro to check one specific address before sending works great for me but how can I add a couple more address to check? Thanks!

    • Diane Poremsky says

      The last macro should do it -- you'll use case statement and list all the addresseses-
      Select Case LCase(Item.To)
      Case "alias@domain.com", "alias2@domain3.com", "alias3@domain3.com"
      Item.Send
      Case Else

  17. Nathan says

    I meant the macro to check for an email address and not send if it is one of the listed addresses. We just want to warn users before they send to certain people. If the email address is not included then there should be no warning.

    Thanks

    • Diane Poremsky says

      The second macro should do it - just switch the actions in the Then and Else lines. If you want to automate it, rather than giving users the choice, remove the msgbox line and just use cancel = true.

      Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
      Select Case LCase(Item.To)
      Case "alias@domain.com", "alias2@domain3.com", "alias3@domain3.com"
      Cancel = True
      Case Else
      Item.Send

      End Select

      End Sub

  18. Nathan says

    The macro is working great now for checking messages as they send, however I get an error when sending meeting invites. "Run-time error '438'": Object doesn't support this property or method.

    The debug option highlights this line:

    If InStr(LCase(Item.To), "test1@test1.com") Then

  19. Nathan says

    Hi, the check before sending macro gives me errors whenever I Send or Accept/Cancel meeting invites. Is there a solution to prevent this?

    The error is from Microsoft Visual Basic "Run-time error '438': Object doesn't support this property or method."

    The macro:

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

    ' 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 bad@address.com. 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

    • Diane Poremsky says

      Do you only get it on meetings? Item.To is the problem.... You can add If TypeName(Item) = "MailItem" Then before the line that checks the address (and add another end if at the end) - if you want to check meetings (and task requests) you need to check the recipients collection. I don't think i have any code handy that does that but will look.

    • Diane Poremsky says

      Or... better yet, add
      On Error Resume Next

      before the IF line. That will allow it to work with meetings too. (At least it does here.)

  20. Nathan says

    Your first reply seems to work (adding If TypeName(Item) = "MailItem").

    I tried the 2nd suggestion but then I get the warning even when the bad address is not used in a meeting invite, so it won't work.

    Adding "If TypeName(Item) = "MailItem"" only checks the address for sending an email, not a calendar invite, but I can live with that. Thanks!!

  21. Nathan says

    Hi, I just realized this will not check the addresses in the "CC" field. Is there a way to check both fields at once? If not, what do we include to verify both fields?

  22. Nathan says

    Is there a way to catch those email addresses which are stored in the autocomplete list in this format: Firstname Lastname (email@domain.com) or Firstname Lastname

    The macro above will only catch the address if it is by itself, not when the above format is used.

    • Diane Poremsky says

      InStr should get a string within a phrase - (and lcase makes sure it ignores capital letters)
      If InStr(LCase(Item.To), "bad@address.com") Then

  23. Ian Matheson says

    This is really useful, thanks. I'm trying to set it up such that I get a warning when I am sending to (To, CC or BCC) any addresses in a specified external domain. I suspect it is something to do with display name, but can't work out how to do it. Any ideas?

    • Diane Poremsky says

      Using this format for the address didn't work?
      If InStr(LCase(Item.To), "@address.com") Then

  24. Ian Matheson says

    Thanks for the reply.

    It works when I manually type the email address, eg
    john.smith@address.com
    but not when I reply to a mail received from the external domain, where Outlook populates the To: field as:
    Smith, John
    I think this is because it is only validating the display name (Smith, John) and not the actual email address.

    Any suggestions gratefully received!!
    (Also, it would be ideal if all recipients were checked rather than just 'ItemTo'...)

  25. Ian Matheson says

    Correction:
    ... but not when I reply to a mail received from the external domain, where Outlook populates the To: field as:
    Smith, John

  26. Ian Matheson says

    Sorry for the repetitive posting, but after a bit of research I think I've worked it out.
    The MailItem.To property is used only for display names, so we want to use the Recipients collection as a catch-all. We just change Item.To to Item.Recipient
    and it all seems to work for both new mails and replies, plus checks the To, CC and BCC fields as well:

    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.Recipient), "bad@address.com") Then
    Prompt$ = "You sending this to bad@address.com. 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

  27. Ian Matheson says

    Sorry... that doesn't work either! Please feel free to edit/delete my comments into one that actually makes sense!!

  28. Mike Beda says

    Hi Diane,

    I wasn't able to make this entirely work for me. It'd work for a new message but not for a reply. I discovered that on replies "Item.Recipients" was blank. Scrounging some other code I managed to change the search term to one that always seems to give the actual email address, so now it works with replies and new messages.

    Thank you for your example. I couldn't have made anything work had I not your code to start with.

    My revised routine is below:

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim Recipients As Outlook.Recipients
    Dim i
    Dim prompt As String
    Dim recip As String

    On Error Resume Next

    Set Recipients = Item.Recipients

    For i = Recipients.Count To 1 Step -1
    recip$ = Recipients.Item(i).Address

    If InStr(LCase(recip), "bad@address.com") Then
    prompt$ = "You are sending this to bad@address.com. 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

    '-Mike Beda

  29. Gordon says

    Thanks Diane - I searched high and low before finding this excellent article.

    I also had trouble with the code not working for replies, but following Mike's excellent reworking of your original code, I now have the safety net I needed up and running.

    Thanks both!

  30. ellie says

    How can i delay my sent mail for a few minuets when its sent to multiple address but the exempted emails like my coworkers should be sent right away so they can notify me lets say if there's a mistake before its to late ?

    So this is my question when using outlook rules i can or delay all emails but when i exempt some emails from the rules the email gets sent right away even its sent to additional mail address ?????

    can you help perhaps macro or script? i am using outlook 2013 with an exchange account ??

    • Diane Poremsky says

      You can use exceptions to apply to the entire email but you can't address a message to coworkers and outsiders and send to coworkers immediately but hold it for outsiders. It's all or nothing. The only way would be to send two messages, one to coworkers and one to outsiders.

  31. Melissa Ferguson says

    I am trying to modify it a little to warn me if mail is sent to specific domains. I was trying to use a wildcard or like statement in the case so that if it is @gmail.com then it will prompt me for something. Is there a way to do that?

    • Diane Poremsky says

      Using just the domain with instr should work:
      If InStr(LCase(Item.To), "address.com") Then

  32. Perry Garrod says

    Hi Diane
    Excellent tutorial.
    I have used is for the basis of a Send check routine, which was working initially, but when I had occaision to restart outlook, whilst the VBA all looks good, the macro doesnt run.
    When I select the design button, I get "The macros in this project are disabled..... please refer" which takes me to a Microsoft site full of info, and I dont know where to start.
    Tried enabling all Macros in Trust settings (2012). Didnt make any differnence
    Any thoughts
    Thanks
    Perry

  33. Alexis says

    Hi Diane, I´ve try several times but it doesn´t work, what can I do? Im using this code with VBA and Im following all the steps... please help!

    • Diane Poremsky says

      What happens when you try? Do you get any error messages? Did it ever work? Is macro security set to low?

    • Alexis says

      Nothing, and I dont get any error messages, and I already verify the macro security and changed it ...Look..

      Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
      If InStr(LCase(Item.To), "alexis.perezcastro@email.com") Then
      prompt$ = "You sending this to alexis.perezcastro@email.com. 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

  34. Perry Garrod says

    Hi Eric, if you are experiencing the same problem I encountered, in that despite having set full access to run all macros, I still had to alt+f10 (I think) to see if macro loaded. I had password protected it. When the enter password window was displayed I new the macro was loaded and from that point all worked ok. Must be a better way of switching on but couldn't font it, which makes for difficult or impossible company role out

    • Diane Poremsky says

      the macro looks good, it should work as long as macro security is set to low/allow all macros. Add
      msgbox "macro starting" before the if line - if the message box comes up, the macro is being called.

  35. Don Persaud says

    Hi Diane
    Thank you for this outstanding forum.
    This is my environment:
    Outlook 2007
    Windows XP
    3 active email accounts, with one set as default.
    Situation:
    I would like a prompt to confirm a SEND when I use the 2 non-default accounts.
    Here is what I did:
    In THISOUTLOOKSESSION i put this code

    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 Not Item.SendUsingAccount = "momandpop@shaw.ca" Then
    Cancel = True
    End If
    End If

    End Sub

    My RESULT:
    It does not send emails from the non-default accounts. It gives a message "this message will be sent from janedow@shaw.ca", however the message sits there without "leaving".

    Please help.
    don

    • Diane Poremsky says

      Do you want the confirmation if you are replying or forwarding a message in either of those accounts?

      This will check for the account then check for reply or forward -
      Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

      On Error Resume Next

      If Not Item.SendUsingAccount = "momandpop@shaw.ca" Then

      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 If

      End Sub

      BTW, the sendusingaccount name is how it's displayed in the From field - in Outlook 2010/2013, it defaults to the email address.

  36. Matt Frey says

    Diane, thanks for this article.

    I've tested the code and it works when I tried sending to @comcast.net and @gmail.com adresses. However, I can't get it to work when I am sending to an internal company address:

    FirstName.LastName@CompanyName.com

    i.e., for me it would be matt'frey@company.com

    What do you suggest I try? Thanks.

    • Diane Poremsky says

      if you are using exchange, it uses the exchange x500 address. If you want to be warned for all internal addresses, try either of these formats:
      If not InStr(LCase(Item.To), "@") Then
      If InStr(LCase(Item.To), "/ou") Then

    • Diane Poremsky says

      try the exchange alias - it's usually the part of the address before @ but check the properties in the GAL to be sure. Use that in place of the address in the macro - use the one that uses the recipient collection to check all recipient fields.

    • matt frey says

      I used an OR statement with both the email address and the alias and it worked. Thanks so much for your help.

  37. Chris says

    Hi,

    Thanks for the tutorial - It works great, but I have one problem. I have a rule setup to automatically forward certain emails to another address.

    When the forwarder rule is hit, it also tries to run the macro - Any way to stop the rule from running the macro?

    Thanks

    Chris

    • Diane Poremsky says

      you can use an if statement to skip it if there is a match, example, if subject = "something" then exit sub.

      What condition do you use for the rule?

  38. Frank says

    Hello, Diane. I have a question. If I only want Outlook to warn me if multiple (DIFFERENT) domains are in an email, how do I do this? I've used your code to notify me if an email does not go to a specific address, but I'm trying to get a warning if emails are sent to multiple (DIFFERENT) domains on the same email. This would be for the TO: and CC: fields. Thanks!

    • Diane PoremskyDiane Poremsky says

      if you want to be warned if sending to specific domains, use a variation of the
      example I just posted in reply to Keith. Using his version of the macro with these changes will warn if sending to the addresses listed but not if sending to others.
      dim Address, lLen
      Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
      lLen = Len(Address) - InStrRev(Address, "@")

      Select Case Right(Address, lLen)
      Case "cdolive.com", "slipstick.com", "outlookmvp.com"
      strMsg = strMsg & " " & Address & vbNewLine
      End Select
      Next

    • Frank says

      Diane, thanks for the reply. My question is this, let's say I have an email going to "diane@example.com", "diane2@example.com", but then mistakenly include "diane3@differentdomain.com". Is there a way to trigger an outlook notification that there are 2 different domains included in the same email (@example.com and @differentdomain.com,)? I don't want to pre-program the domains that are "acceptable", just want outlook to warn that I have an email with 2 different domains. This is to prevent an email from going to people from different companies.

    • Diane PoremskyDiane Poremsky says

      Possible, I think so. I don't have any code samples though. How many addresses would messages typically be sent to? It'll obviously be easier if there are fewer messages to loop through - you'd need to split the recipients into any array then check for duplicates.

      Ohhhh... that wasn't as difficult as I though it would be. Replace the end of the check multiple domains code with this

      Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
      lLen = Len(Address) - InStrRev(Address, "@")
      str1 = Right(Address, lLen)

      strRecip = str1 & "," & strRecip
      Next
      arr = Split(strRecip, ",")
      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

    • Bordan52 says

      Hi Diane, thank you for all of the great advice I found here. Do you think it would be possible to add exceptions to Frank's code above? Say I receive an email from domain1.com, and I reply copying people from domain1.com and also our own domain at our company (let's call this owndomain.com). This is fine, no popup message necessary in this case. The issue is when I accidentally reply to people on a third domain as well. So basically I was wondering if it were possible to add "owndomain.com" as an exception to the code above? Thank you in advance!

    • Diane PoremskyDiane Poremsky says

      so you want no warning if your domain + one other, and warnings if there is a 3rd domain? (Or always ignore your domain.) We can do that, I just have to think of the best way to do it.

    • Bordan52 says

      Yes, perhaps the best way to put it is to simply leave out our own domain
      Thank you for your help!

    • Diane PoremskyDiane Poremsky says

      Try this
      under the const line:
      ' 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)

      then replace the strRecip = line with this

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

    • Bordan52 says

      Hi Diane, thank you, this works :)

      Please note that I needed to add the following lines to the beginning of the code to avoid variable not found errors:

      Dim str1
      Dim strRecip
      Dim i
      Dim j

      I am not sure if this is correct, but it does make the macro work. Thanks again!

    • Bordan52 says

      Hi again Diane! I have another query that unfortunately I could not figure out myself. Is there any way for the macro to be triggered only when specific domains are involved? For example when I am sending an email to recipient1@gmail.com and recipient2@yahoo.com it should not trigger, but when I am sending an email to recipient1@client.com, it should check if there are multiple domains in the recipient list. I understand that in order to be able to do this, I will need to add a list of domains to trigger the macro (very much like in the "Check for multiple domains" macro). Thank you very much in advance for your guidance!

    • Bordan52 says

      Hi Diane, I am trying to combine the code of Keith and Frank, as I would like Frank's macro to be triggered only when I am sending an email to certain domains (me.com or gmail.com in this case). I do not get any error messages, but the macro is triggered for all domains, not only for these two. Could you please let me know how I should modify the code? Thank you vry much in advance!

      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
      Dim str1
      Dim strRecip
      Dim i
      Dim j

      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)

      Select Case Right(Address, lLen)
      Case "me.com", "gmail.com"
      strMsg = strMsg & " " & Address & vbNewLine
      End Select

      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

  39. rinzemak says

    This works flawlessly...but only if I use certain email addresses. For some reason, it will not work when I use an email address for someone within our company. Is there a reason for this and a quick fix?

    Keith

    • Diane PoremskyDiane Poremsky says

      Exchange? It's because exchange uses an x.500 address format. For internal mail, look for /ou. For specific internal users, try their alias (in most companies this is the part before the @).

      you can use this macro to get the x500 address for an internal sender:
      Public Sub Getx500Address()
      Dim objMail As Object
      Set objMail = Application.ActiveExplorer.Selection.Item(1)
      MsgBox objMail.SenderEmailAddress
      Set objMail = Nothing
      End Sub

    • Diane PoremskyDiane Poremsky says

      BTW, you can use a propertyaccessor to get the SMTP address for Exchange users. See Keith's code below for an example.

  40. Keith says

    Hello Diane,
    thank you for sharing your great work.
    I am currently using the following code to provide an alert when sending email outside of our company i.e if the recipient address does not include our name “@motorabc”. This works great but I would also like to add an additional company address, so the alert is shown when not sending to either “@motorabc” or “@aeroabc”.
    Could you please advise of how to best achieve this, my VB skills are fairly basic & I have failed miserably in trying to resolve this.

    Many thanks Keith

    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

    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
    If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@motorabc") = 0 Then
    strMsg = strMsg & " " & pa.GetProperty(PR_SMTP_ADDRESS) & vbNewLine
    End If
    Next

    If strMsg "" Then
    prompt = "This email will be sent outside of MotorABC 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

    • Diane PoremskyDiane Poremsky says

      Ok... so the other attempts didn't work but this one does. I'm assigning the address to a variable since it's called more than once, plus it makes it easier to see what I'm doing. (InstrRev starts at the right of the string.)
      dim Address, lLen
      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
      strMsg = strMsg & " " & Address & vbNewLine
      End Select
      Next

  41. Keith P says

    Many thanks for the advice Diane.

    Another solution I created using 'Or' was which appears to work for two addresses is:

    If (InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "“@motorabc ") Or InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@aeroabc ")) = 0 Then

    • Diane PoremskyDiane Poremsky says

      Yes, OR works too, but it gets long and unwieldy if you have multiple addresses to check.

  42. Keith P says

    Hello Diane, I agree OR would be unwieldy, as I anticipate I will be required to filter on several addresses, I will look forward to implementing your suggestion instead.

    Your assistance is really appreciated :-)

    Kind regards Keith

    • Keith Pearce says

      Hi Diane, I have encountered an additional problem, when sending a mail which includes the use of a distribution list the following run-time error appears;

      Run-time error '-2147221233 (8004010f)':

      The property
      "http://schemas.microsoft.com/mapi/proptag/0x39FE001E" is unknown or cannot be found.

      Kind regards

      Keith P

    • Diane PoremskyDiane Poremsky says

      Is this an outlook DL or an Exchange DL in the GAL? I'm guessing the addresses haven't expanded yet, causing the error - expanding the dl should fix it. You can use code to expand it (I have a code sample here somewhere - I'll see if i can find it)

  43. Frank says

    Diane, thanks for the reply. I do have another question...and perhaps you've commented on it already, so I apologize.
    What I want to do is have a pop-up if the email will be sent to individuals across different ".coms". I don't want to pre-program specific ".coms" in the code. I want outlook to give me a warning if the domains are different, period.
    Is this possible?
    I used the code you've provided but I believe I have to type in specific emails in order for it to work? Is this correct? Am I not using the code properly?

    • Diane PoremskyDiane Poremsky says

      The code at Check for different domains above check to see if recipients are in different domains.

  44. Keith Pearce says

    Thanks for the reply Diane,
    to my knowledge the DL Run-time error '-2147221233 (8004010f)' issue has so far only occurred with DL's created in the user's personal contacts address book, which I suspect haven't expanded. As far as I'm aware, no issues have occurred when using Exchange DL's.

    Best regards.

    Keith P

    • Diane PoremskyDiane Poremsky says

      That makes sense, because outlook needs to expand the personal dl on the desktop while exchange expands the GAL DLs. You need to loop through the dl and expand it.

    • Keith P says

      Diane, sorry to be a nuisance but could you advise of the code required to loop through the dl and expand it?

      Best regards.

      Keith P

  45. Frank says

    Diane, good afternoon. I entered the code exactly as you have it shown in your reply to me, but cannot get it to work. The message still sends even though I've entered different domains - (in my case, @aol.com, and @gmail.com). I went back to make sure that all macros would be trusted and all was well here. Is there something that I'm missing? I've tried several times. Thanks for your patience.

  46. George Vic says

    Hello,I am using a pc that has 3 outlook accounts, but when i reply i want to always send from my account. (Unfortunately,default doesnt work when i reply on another accounts' email)
    So i would like to know if there is any code for outlook 2010 to prevent from sending from other than specified email addresses?

    A condition like:

    If InStr(LCase(Item.From), "bad@address.com") Then

    Please help me with this macro

    • Diane PoremskyDiane Poremsky says

      The last macro on the page should work for you. Replace the If line with this, with the default account name in the quotes. If you send using the other accounts, it will warn you and you can cancel the send and change the address.
      If Not Item.SendUsingAccount = "my-default-account@domain.com" Then

      This might help for new message - reg key to send new message from default account

      Also, if they are pop or imap accounts, you can change the From address settings. Use the correct incoming settings and the same smtp settings as for the default account. See Create a fake pop accountfor instructions and screenshots.

  47. Paula Portal (@PaulaPortal) says

    Dear Diane,

    I am a complete dumb when it comes to VBA ans Scripts. so I just Google what I need and, hopefully, with some small adaptations, I can move on.

    This time I am working on a wonderful script I found to automate email delivery (with atachments), but I cant't figure out how to launch a message asking the operator "Do you really want to send the e-mail?" before the email is sent. I do want to keep ti in the back end so that the operator can not change the email text, nor the attachment, though I would like to give him/her the chance to confirm the delivery to avoid un-intended emails.

    Here's the script as it is:

    Sub AttachActiveSheetPDF()
    Dim IsCreated As Boolean
    Dim i As Long
    Dim PdfFile As String, Title As String
    Dim OutlApp As Object

    ' Not sure for what the Title is
    Title = Range("A1")

    ' Define PDF filename
    PdfFile = ActiveWorkbook.FullName
    i = InStrRev(PdfFile, ".")
    If i > 1 Then PdfFile = Left(PdfFile, i - 1)
    PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

    ' Export activesheet as PDF
    With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With

    ' Use already open Outlook if possible
    On Error Resume Next
    Set OutlApp = GetObject(, "Outlook.Application")
    If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
    End If
    OutlApp.Visible = True
    On Error GoTo 0

    ' Prepare e-mail with PDF attachment
    With OutlApp.CreateItem(0)

    ' Prepare e-mail
    .Subject = Title
    .To = "..." ' <-- Put email of the recipient here
    .CC = "..." ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
    & "The report is attached in PDF format." & vbLf & vbLf _
    & "Regards," & vbLf _
    & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile

    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
    MsgBox "E-mail was not sent", vbExclamation
    Else
    MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0

    End With

    ' Delete PDF file
    Kill PdfFile

    ' Quit Outlook if it was created by this code
    If IsCreated Then OutlApp.Quit

    ' Release the memory of object variable
    Set OutlApp = Nothing

    End Sub

    Could you, please, help me?

    Thanks!
    Paula

    • Diane PoremskyDiane Poremsky says

      Try replacing the Send line with this:
      ' Try to send
      On Error Resume Next
      Dim prompt As String
      prompt = "This email is being sent to " & .to & " and " & .cc & " Do you still wish to send?"
      If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
      Cancel = True
      Exit Sub
      End If

      .Send

  48. Jason says

    Hello, We are using Frank's version to check when messages are sent to multiple domains and it is working great, however we have multiple internal domains and are wondering if there is a way to add additional internal domains to be excluded from the check to the macro we are using.

    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

    Any thoughts?

    -Jason

    • Diane PoremskyDiane Poremsky says

      Depending on how many you have, you'd either use IF OR statements in this line - you could remove the lines that get your domain too.
      If str1 <> "mydomain.com" or str1 <> "otherdomain.com" Then
      or an array.

  49. Andrew says

    I am using the third macro to check the To, CC, and BCC recipients. This macro works great for one single address. How can I modify it to check for multiple addresses?

    • Diane PoremskyDiane Poremsky says

      You want to check for something like "if sent to person@domain.com or someone@domain2.com" ? The Check for multiple domains code right after that can do multiple addresses.

      Change the lines that check the address to this (didn't test it, hopefully i didn't make a mistake)

      Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))

      Select Case Address
      Case "alias@cdolive.com", "person@slipstick.com", "someone@outlookmvp.com"

  50. Frank says

    Diane,

    I just noticed on the code that you helped with (still LOVE! it) the alert prompts me about the discrepancy only in the last two domains included in the email.

    For example, if in the To: I have diane@domain.com, diane@domain2.com, and diane@domain3.com, I'd get the alert that domain2 and domain3 were different.

    If I had an email with To: diane@domain.com, diane@domain2.com, diane@domain3.com, and diane@domain4.com, I'd get the alert that domain3 and domain4 were different.

    If the To: field was diane@domain.com and diane@domain2.com and in the CC: field was diane@domain3.com, I'd get an error on domain2 and domain3.

    What would be ideal is to have an alert that states: "This email is being sent to people at domain, domain2, domain3 and domain4 (or however many emails). Do you still wish to send?"

    Could you please help with the code for this one?

    Thank you.

    • Diane PoremskyDiane Poremsky says

      the check for different domains checks the array backwards: For i = LBound(arr) To UBound(arr) - 1 so it should pick up the last two added as recipients. It quits as soon as it makes a match and doesn't continue checking the rest of the recipients. If you want to list all of the domains in the warning, use strRecip in place of arr(i) & " and " & arr(j)

Leave a Reply

Please post long or more complicated questions at OutlookForums by Slipstick.com.

If the Post Comment button disappears, press your Tab key.