Forward meeting details to another address

Last reviewed on June 2, 2013   —  10 comments

In our article discussing BCCing messages, Michael wanted to BCC all incoming meeting requests and cancellations to another address. You can do this with a run a script rule. The macro at the bottom of the page is an ItemAdd macro and watches for new items to be added to the calendar, forwarding appointment details as well as meeting details to another address.

The Run a script version is built off of the AutoAcceptMeeting request code sample.

To use this macro, open the VBA Editor (Alt+F11) and paste the code into ThisOutlookSession.

Next you will need to create a rule that looks for meeting cancellation or meeting request forms then choose the Run a Script action.
Forward meeting Request Rule

The macro creates and sends a message containing appointment details. The message body will look like the following screenshot and can be edited to add or remove fields.

Forward Meeting Details

Sub ForwardMeetingDetails(oRequest As MeetingItem)
 
Dim oAppt As AppointmentItem
Set oAppt = oRequest.GetAssociatedAppointment(True)
  
 
Dim fwdAppt As MailItem
Set fwdAppt = Application.CreateItem(olMailItem)
 strBody = "Organizer: " & oAppt.Organizer & vbCrLf _
 & "Start: " & oAppt.Start & vbCrLf & "End: " & oAppt.End _
 & vbCrLf & "Location: " & oAppt.Location & vbCrLf & "Message: " & oAppt.Body
  
With fwdAppt
 .Recipients.Add "alias@domain.com"
 .Subject = oAppt.Subject
 .Body = strBody
 .Send
End With


End Sub

Forward appointment details when an appointment is added to the calendar

With a few tweaks to the macro above, you can forward all appointments added to your calendar to another address.

This macro watches for new items to be added to the calendar and sends the details in a message.

It's an Application_Startup procedure and runs when Outlook starts. To test it without restarting Outlook, click in the Application_Startup macro and press Run (F5).

This macro needs to be in ThisOutlookSession.


Dim WithEvents newAppt As Items
  
Private Sub Application_Startup()
   Dim NS As Outlook.NameSpace
   Set NS = Application.GetNamespace("MAPI")
   Set newAppt = NS.GetDefaultFolder(olFolderCalendar).Items
   Set NS = Nothing
End Sub
  
Private Sub newAppt_ItemAdd(ByVal Item As Object)

Dim fwdAppt As MailItem
Set fwdAppt = Application.CreateItem(olMailItem)
Dim strBody As String
 strBody = "Organizer: " & Item.Organizer & vbCrLf _
 & "Start: " & Item.Start & vbCrLf & "End: " & Item.End _
 & vbCrLf & "Location: " & Item.Location & vbCrLf & "Message: " & Item.Body
   
With fwdAppt
 .Recipients.Add "maryc@domain.net"
 .Subject = Item.Subject
 .BodyFormat = olFormatPlain
 .Body = strBody

'Use Display to view onscreen and send yourself. Send will send it automatically
' .Display 
 .Send
End With
    
End Sub

Written by

Diane Poremsky
A Microsoft Outlook Most Valuable Professional (MVP) since 1999, Diane is the author of several books, including Outlook 2013 Absolute Beginners Book. She also created video training CDs and online training classes for Microsoft Outlook. You can find her helping people online in Outlook Forums as well as in the Microsoft Answers and TechNet forums.

Please post long or more complicated questions at Outlookforums.

10 responses to “Forward meeting details to another address”

  1. Alwyn

    Hi Diane,

    The macro works great but is there a way to send an exact copy of the appointment as an appointment to an external email address instead an email? I would like to see what is in my work outlook calendar in my day to day one with Gmail and as google sync is no longer available this is proving difficult

  2. Alwyn

    I've come up something and it does do what it's told, however it repeats the action as each time a new appointment is added to the calendar it send another appointment - I've had a total of 156 appointments being sent before I figured it out. Currently I've changed from .send to .display to get around this. Is there another way?

    Or is it possible to forward all new appointments to gmail without it also displaying on my calendar for a second time?

  3. Alwyn

    This is the code that I've written based on your code. Thanks in advance

    Dim WithEvents newAppt As Items

    Sub Application_Startup()
    Dim NS As Outlook.NameSpace
    Set NS = Application.GetNamespace("MAPI")
    Set newAppt = NS.GetDefaultFolder(olFolderCalendar).Items
    Set NS = Nothing
    End Sub
    Error
    Sub newAppt_ItemAdd(ByVal Item As Object)
    Dim fwdAppt As AppointmentItem
    Set fwdAppt = Application.CreateItem(olAppointmentItem)
    With fwdAppt
    .MeetingStatus = olMeeting
    .Recipients.Add "alwynw27@gmail.com"
    .Subject = "Copy" & Item.Subject
    .Start = Item.Start
    .Duration = Item.Duration
    .Location = Item.Location
    .Sensitivity = olPrivate
    'Use Display to view onscreen and send yourself. Send will send it automatically .display .send'
    .Display
    End With
    Set fwdAppt = Nothing

  4. Alwyn

    Hi Diane,

    Sorry for the very late reply but this didn't work at all. I tried to delete the srs file in case it was corrupt but nothing.

    I did write this however from another code on the web, it works for me but can't seem to get it to work for other users! Any help would be appreciated. Ideally the first code would be better as its an automatic process. Thanks in advance!

    'This is the email you want to forward meeting items to
    Private Const forwardMeetingsTo As String = "nev_evans@hotmail.com"
    'This is the prefix in the subject for forwarded meeting appointments
    Private Const forwardSubjectPrefix As String = "[CalSync] "

    Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
    ' Call to forward AppointmentItems on to a different address. The called method is responsible for determening the type of Item and for cleaning it before sending it on
    Call ForwardmeetingRequests(item)
    End Sub

    'This method is called from the SendItem event, and will start the clean-and-forward
    'procedure for Meeting requests
    Private Sub ForwardmeetingRequests(ByVal item As Object)
    Dim ic, bIsDuplicateAppointmentItem As Boolean
    Dim prop
    bIsDuplicateAppointmentItem = False
    ''''Start check to see if Item is a meeting. If so, make a call to forward it
    ic = item.Class
    Select Case ic
    Case olMeetingRequest: '53

    Set prop = item.UserProperties.Find("DuplicateItemv2")
    If TypeName(prop) "Nothing" Then
    bIsDuplicateAppointmentItem = True
    End If

    If bIsDuplicateAppointmentItem = False Then
    Call ForwardMeetingItem_CreateNewItem(item, forwardMeetingsTo)
    End If
    End Select

    End Sub

    'This sub is used to 'forward' meeting items.
    'Forwarding creates some problems, so a blank meeting request is created,
    'and several properties are copied from the original one to the new one.
    'The new one is then sent and deleted right afterwards
    Private Sub ForwardMeetingItem_CreateNewItem(ByVal incommingItem, ByVal sendTo As String)
    ''''Create a new meeting item and copy what is needed from the incoming one
    Set myAppt = incommingItem.GetAssociatedAppointment(False)

    Dim fwdMeetingItem As Object
    Set fwdMeetingItem = myAppt.Application.CreateItem(olAppointmentItem)
    fwdMeetingItem.MeetingStatus = olMeeting

    fwdMeetingItem.Subject = forwardSubjectPrefix & myAppt.Subject
    fwdMeetingItem.Start = myAppt.Start
    fwdMeetingItem.End = myAppt.End
    fwdMeetingItem.Location = myAppt.Location
    fwdMeetingItem.Sensitivity = olPrivate
    fwdMeetingItem.ReminderMinutesBeforeStart = 15
    fwdMeetingItem.ReminderSet = True

    fwdMeetingItem.Importance = myAppt.Importance

    ''''Add a recipient
    fwdMeetingItem.Recipients.Add "nev_evans@hotmail.com"

    Dim prop
    Set prop = fwdMeetingItem.UserProperties.Add("DuplicateItemv2", olText)

    ''''Send item .send or .display
    fwdMeetingItem.Send

    ''''Delete the forwarded item from the calendar
    fwdMeetingItem.Delete
    End Sub

    'This is called by the Rule in Outlook
    Sub CustomMeetingRequestRule(objItem As Outlook.MeetingItem)
    If objItem.Class = olMeetingRequest Then '53
    Call ForwardMeetingItem_CreateNewItem(objItem, forwardMeetingsTo)
    End If
    End Sub

  5. Tomas V.

    Hi Diane,
    is there any option how to forward meeting request to personal email with no information to organizer?

Leave a Reply

If the Post Coment button disappears, press your Tab key.