Change account settings in Outlook 2010 using VBA - vba

Question

I have a large number of forwarding email addresses which are all set to forward to the same email account. I find this is useful because if a business is hacked and my email address is stolen then I only have the change the email address for that business. For example, "amazon#mydomain.com", "ebay#mydomain.com" and "facebook#mydomain.com" would all be forwarded to "mailbox#mydomain.com".
When I want to send an email to the business, I have to go into Outlook and change the account set up to have the forwarding email address as the email address. I find this a nuisance. I know I can change who the email is from when I write it, but then the recipient sees "J Smith on behalf of newaddress#mydomain.com". I would rather it just showed the address I am using in the from field, as it does if I go into the account set up and change the email address there.
It would be nice to have a macro set up which asked me which email address I wanted to use and then sent the email for me. I have looked up how to change email account details in VBA, but it looks as if the details are all read-only. Is there a way to change my "from" email address cleanly? Or even setting up a new email account in VBA and deleting it immediately after sending it?

Answer 1

Try creating a userform with a combobox and a button on it. Load all your available accounts into the combobox to be able to select from it:
Private Sub UserForm_Initialize()
Dim acc As Account
For Each acc In ThisOutlookSession.Session.Accounts
Me.ComboBox1.AddItem acc.UserName
Next acc
End Sub
Then add some code to the button that selects the proper account:
Dim objApp As Outlook.Application
Dim objMail As Outlook.MailItem
Set objApp = ThisOutlookSession.Application
Set objMail = objApp.CreateItem(olMailItem)
With objMail
.To = "lala#lala.com"
.CC = ""
.BCC = ""
.Subject = "Test"
.Body = "Test"
Dim i As Integer
For i = 1 To ThisOutlookSession.Session.Accounts.Count Step 1
If ThisOutlookSession.Session.Accounts.Item(i).UserName = Me.ComboBox1.Value Then
.SendUsingAccount = ThisOutlookSession.Session.Accounts.Item(i)
End If
Next i
.Display
End With
Maybe there is an event that is called when you are creating a new email, otherwise you have to add a button or something to bring the form up.

Answer 2

I had this exact same problem and ended up being able to solve it by installing Outlook Redemption and using the following script...
' Redemption code below. Must install Redemption to work.
' http://www.dimastr.com/redemption/faq.htm#14
Dim sItem, Tag
Set sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = oMailItem
Tag = sItem.GetIDsFromNames("{00020386-0000-0000-C000-000000000046}", "From")
Tag = Tag Or &H1E 'the type is PT_STRING8
sItem.Fields(Tag) = GetHashedReply(oMailItem)
Tag = sItem.GetIDsFromNames("{00020386-0000-0000-C000-000000000046}", "Sender")
Tag = Tag Or &H1E 'the type is PT_STRING8
sItem.Fields(Tag) = GetHashedReply(oMailItem)
sItem.Subject = sItem.Subject 'to trick Outlook into thinking that something has changed
sItem.Save
...where oMailItem is a normal Outlook MailItem that you can get with CreateItem() or get passed to you in the ItemSend() parameters.