Outlook 2007 Prompt for mail account when sending email

Like many people I have my outlook configured with multiple mail accounts, one for personal, one for work and a couple for my freelance work. However when you send an email, Outlook assume you want to send it using your default mail account. This can often mean that you send email using the wrong address which can cause problems.

Now, I know you can easily change the Mail account by clicking on the Account button beneath the Send button. However it is very easy to forget or think you have it set right, only to find out later it was wrong. However what I really want is for outlook to prompt me every time I send an email, thus I will never forget and it should stop me from using the wrong account.

After reading many forum posts by people searching for a solution without success, I decided to write code this myself. This is the first time I have programmed Outlook before. But the results are good.

Now whenever I click send I get a small popup form appear (See above) which   lists my mail account. It will highlight the current default account, but I can   then select a different account if required. Once I press enter or click send its   done. Or what is equally convenient is the second chance to cancel.

So how does it work?

Well the first thing to note is that this solution only works for Outlook   2007 or newer as it makes use of the “SendUsingAccount” method, which is new to   Outlook 2007.

I then use the function call “Private Sub Application_ItemSend(ByVal item As   Object, Cancel As Boolean)” to interrupt the sending of the email, to allow me   to open up the form which gets the list of accounts.

I have also added a couple of extra bits of code (while I was on a roll) to   prevent me from sending emails without a subject. It also checks to see if I   have used the word “attach” in my email and if there are no attachments it will   ask me if I meant to send the email without any attachments.

One other setting I had to change, was the security settings, as the code   would not run unless I had set the security level to “No security check for   macros”. (This is done by going to Tools -> Macros -> Security) – As long   as you do not make a habit of installing macros you should be safe, but if anyone   has a way of making this code work without having to disable macro security I   would be glad to hear from you.

The Code:

ThisOutlookSession

Public blnSend As Boolean
Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
	If TypeOf item Is Outlook.mailItem Then
    	blnSend = False
        Load frmAccountList ' Load account list form
        frmAccountList.Show
        If blnSend Then
        	' Check that the message has a subject - Compulsory!
        	If item.Subject = "" Then
            	MsgBox "You forgot the subject."
                Cancel = True
            Else
            	' Check that attachment has been added
            	If InStr(1, item.Body, "attach", vbTextCompare) > 0 Then
                	If item.Attachments.Count = 0 Then
                    	ans = MsgBox("There is no attachment, send anyway?", vbYesNo)
                      	If ans = vbNo Then
                           	Cancel = True
                        End If
                     End If
                 End If
			End If
        Else
			Cancel = True
		End If
	End If
End Sub

frmAccountList

Create a New Form, and layout the two buttons and list box.

frmAccountList Code

Private Sub butCancel_Click()
	frmAccountList.Hide
End Sub

Function changeAccount()
	Dim item As mailItem Set item = Application.ActiveInspector.CurrentItem
    ' Change Mail Account
    item.SendUsingAccount = Application.Session.Accounts(lstMailAccounts.Value)
    ' Enable Sending
    ThisOutlookSession.blnSend = True
    frmAccountList.Hide
End Function

Private Sub butSend_Click()
	Call changeAccount
End Sub

Private Sub lstMailAccounts_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 
	If KeyAscii = 13 Then 
    	' On Enter Key Press
        Call changeAccount
    End If
End Sub

Private Sub UserForm_Initialize()
	Dim item As mailItem
    Set item = Application.ActiveInspector.CurrentItem
    Dim oAccount As Outlook.Account
    For Each oAccount In Application.Session.Accounts
    	If oAccount.AccountType = olPop3 Then
        	lstMailAccounts.AddItem (oAccount)
            If oAccount = item.SendUsingAccount Then
            	lstMailAccounts.Value = oAccount
            End If
        End If
    Next
End Sub

And thats it…