Sending from a Selected Account in Microsoft Outlook
Today, many people use several e-mail accounts for communication due to the popularity of free accounts that you can set up anytime. In Microsoft Outlook 2007/2010 you can choose the account which you want to send the message from (Fig. 1.).
Fig. 1. Manual account select prior to sending a message.
Unfortunately, sometimes we accidently send a message from a different account that we initially wanted to. We can prevent that from happening by setting a proper rule that will delay sending the message and will ask for an account to send from.
Below, there is an example of an alternative way of choosing an account before sending the message.
http://outlooktalk.com/article/upload/290.jpg
Fig. 2. An alternative window that asks for an account before sending a message.
If the user will provide an incorrect number in the window (Fig. 2.) the message will not be sent and an appropriate error window will be displayed.
Put the following code in the "ThisOutlookSession" class in the Visual Basic macro editor:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'MVP Shon Oskar - VBATools.pl
If Item.Class = 43 Then
Dim objMailItem As MailItem, ChangeMail As MailItem
Dim olNS As Outlook.Namespace
SET olNS = Application.GetNamespace("MAPI")
Dim choose$, list$, x&
For x = 1 To olNS.Accounts.Count
list = list & x & " -" & olNS.Accounts.Item(x).DisplayName & vbCr
Next x
choose = InputBox("Choose your account number from the list:" & vbCr & list, _
"Sending from a selected account VBATools.pl", 1)
If Len(choose) = 0 Then Cancel = True
If IsNumeric(choose) = True Then
If choose > x Then GoTo error
Set objMailItem = Item
With objMailItem
Set ChangeMail = .Copy
.Delete
Cancel = True
End With
With ChangeMail
.SendUsingAccount = olNS.Accounts.Item(choose)
.Save
.Send
End With
Else
error:
Cancel = True
MsgBox "You didn't choose proper account number", vbExclamation, _
"Sending from a selected account VBATools.pl"
End If
Set ChangeMail = Nothing
Set objMailItem = Nothing
Set olNS = Nothing
End If
End Sub
After you save the above procedure it may be necessary to restart MS Outlook.
If you are not experienced in macro installation, please refer to this article
(c) Shon Oskar
© All rights reserved. No part or whole of this article may not be reproduced or published without prior permission.
Oryginal article publicate at this page