Introduction
Have Outlook configured with multiple acocunts? Your work account and several personal accounts? Ever accidently send a work email from your personal acccount? This bit of Outlook code will prompt you for those mistakes.
Background
I have found that I often end up sending work emails from my personal accounts that I have configured in Outlook. So VBA to the rescue.
Using the Code
Insert the following code in the ThisOutlookSession
module. You can do this by showing the developerribbon on the menu. Then selecting the developer ribbon/ Visual Basic on the far left of the ribbon.
In the application section, insert the following code. You can open up 'ThisOutlookSession
' which opens up the correct source code file. Make sure the application is selected on the upper left hand drop down box.
You need to make two changes in the code below in the bolded area. Replace the first bold with the account name you are sending from. Note you can find this out by setting a break point in the debugger on the 2nd if
statement and printing out the mail.SendUsingAccount
when you send mail from your work account.
The 2nd bolded section is the domain name of your companies email address. So if your company is ZYX
and your email address is <a href="mailto:brady@ZYX.com">brady@ZYX.com</a>
, then replace it with ZYX
.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
Dim mail As Outlook.MailItem
Dim r As VbMsgBoxResult
Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
If Item.Class = olMail Then
Set mail = Item
If mail.SendUsingAccount <> "myname@mycompanyemail.com" Then
Const PR_SMTP_ADDRESS As String = _
"http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
Set recips = mail.Recipients
For Each recip In recips
Set pa = recip.PropertyAccessor
Debug.Print recip.Name & " SMTP=" _
& pa.GetProperty(PR_SMTP_ADDRESS)
If InStr(1, pa.GetProperty(PR_SMTP_ADDRESS), "companyDomain", vbTextCompare) > 0 Then
r = MsgBox("Do you want to send to companyDomain from non companyDomain account?", vbYesNo)
If r = vbNo Then
Cancel = True
Exit For
End If
End If
Next
End If
End If
End Sub