Outlook - Automatically forwarding e-mails when the server does not support it
I was recently allocated a Microsoft BPOS Online Services Exchange account for a client and I was configuring the same in Outlook. To keep up with the emails on the new account, I wanted to receive all incoming/outgoing emails for this BPOS account to my another email account that is synced across multiple devices I use.
Should be pretty easy I thought, and I set-up a Rule to automatically forward all incoming mail to my other account. But when I tested it, it did not work. Googling revealed that by default, BPOS Exchange Online account emails cannot be forwarded to another email outside the domain, but administrators can set up a rule for it via PowerShell.
What the heck I thought, there should be some way to get around this. My developr roots quickly took me to the Macros section in Outlook where I started fiddling with VBA code to monitor incoming emails.
After some tries (and googling), I was able to settle down with Outlook's NewMailEx event for the purpose and I set-up the following code to automatically forward all incoming emails to another account (via VBA code):
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String) Dim varEntryIDs Dim objItem Dim i As Integer varEntryIDs = Split(EntryIDCollection, ",") For i = 0 To UBound(varEntryIDs) Set objItem = Application.Session.GetItemFromID(varEntryIDs(i)) 'MsgBox (varEntryIDs(i)) Set myItem = objItem.Forward myItem.Recipients.Add "firstname.lastname@example.org" myItem.Send 'myItem.Delete myItem = Nothing Next End Sub
And when I tested it, it worked perfectly. I thought there might be other people in my situation, so I shared the code here.
For completeness sake, the following 2 Outlook event handlers now forward all incoming email for my Exchange account to another email id, as well as add my other id automatically to BCC list when sending email from the Exchange account:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim objRecip As Recipient Dim strMsg As String Dim res As Integer Dim strBcc As String On Error Resume Next ' #### USER OPTIONS #### ' address for Bcc -- must be SMTP address or resolvable ' to a name in the address book strBcc = "email@example.com" Set objRecip = Item.Recipients.Add(strBcc) objRecip.Type = olBCC If Not objRecip.Resolve Then strMsg = "Could not resolve the Bcc recipient. " & _ "Do you want still to send the message?" res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _ "Could Not Resolve Bcc Recipient") If res = vbNo Then Cancel = True End If End If Set objRecip = Nothing End Sub Private Sub Application_NewMailEx(ByVal EntryIDCollection As String) Dim varEntryIDs Dim objItem Dim i As Integer varEntryIDs = Split(EntryIDCollection, ",") For i = 0 To UBound(varEntryIDs) Set objItem = Application.Session.GetItemFromID(varEntryIDs(i)) 'MsgBox (varEntryIDs(i)) Set myItem = objItem.Forward myItem.Recipients.Add "firstname.lastname@example.org" myItem.Send 'myItem.Delete myItem = Nothing Next End Sub
Please note that this will work for incoming/outgoing mails when accessed from the particular Outlook instance where the code has been configured. If you try to access the Exchange account from OWA or another email client (e.g. on your mobile device), this simply won't work as the code runs locally within Outlook (and not on your email server). Also if you delete/archive an incoming email from let's say OWA, the same won't be captured by the above code and hence won't be forwarded to your another account.
But its still better than nothing, the only sureshot way of forwarding all incoming email from BPOS online account is to request your domain administrator to create a rule specific for your mail account.