Forwarding messages in Outlook

In Foward a message and CC the original recipients, Outlook MVP Diane Poremsky posted some VBA code that shows you how to forward a message and automatically copy the original recipients on the new message.

As quick and dirty code there is no problem. But in my armchair with plenty of time to kill, I can nitpick small issues I find with it.

For example, it uses the CC Property directly. While this technically isn't a problem, you should really be interacting with message recipients using the Recipients Collection.


Note to Microsoft: I know you don't care about VBA anymore, but if you are going to continue to include it with Microsoft Office, please make the MailItem.To, MailItem.Bcc and MailItem.Cc properties read-only. Thanks.


Also, as mentioned in the article, it doesn't eliminate your email address from the recipient list. So here is my version which works on my machine.

Sub ForwardwithCC_JP_Version()

Dim obj As Object
Dim msg As Outlook.MailItem
Dim fwd As Outlook.MailItem
Dim msgrecips As Outlook.Recipients
Dim msgrecip As Outlook.Recipient
Dim fwdrecip As Outlook.Recipient

Set obj = GetCurrentItem

If TypeName(obj) = "MailItem" Then
  Set msg = obj
  Set msgrecips = msg.Recipients
  
  ' forward email, loop through recipients and add everyone
  ' except the current user
  Set fwd = msg.Forward

  For Each msgrecip In msgrecips
    If msgrecip.name <> Outlook.GetNamespace("MAPI").CurrentUser Then
      Set fwdrecip = fwd.Recipients.Add(msgrecip.name)
      fwdrecip.Type = olCC
    End If
  Next msgrecip
  
  fwd.Display
  
End If

End Sub

Very simply, it forwards the currently selected or open message and adds all of the original recipients (minus yourself) to the recipient list. You are shown the message so you can forward it to whomever you choose.

I can see the For loop needing some adjustment depending on your local environment, namely, how names are displayed. I am posting what worked for me. FYI this worked in Outlook 2010 as well as 2003.

This procedure uses common functions we have seen before on the site, namely

Function GetCurrentItem() As Object
  Select Case True
  Case IsExplorer(Application.ActiveWindow)
    Set GetCurrentItem = ActiveExplorer.Selection.Item(1)
  Case IsInspector(Application.ActiveWindow)
    Set GetCurrentItem = ActiveInspector.CurrentItem
  End Select
End Function
Function IsExplorer(itm As Object) As Boolean
  IsExplorer = (TypeName(itm) = "Explorer")
End Function
Function IsInspector(itm As Object) As Boolean
  IsInspector = (TypeName(itm) = "Inspector")
End Function

You will need to include these in your Outlook VB Project for the procedure to work properly.

About JP

I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space to learn more about VBA. Keep Reading »


Related Articles:


Share This Article:

Share and bookmark this articledelicious buttonfacebook buttonlinkedin buttonstumbleupon buttontwitter button

This article is closed to any future comments.
Excel School