Sanitized Outlook Event Forwarding Macro

AAA_Readme for Sanitized Outlook Event Forwarding.md

Sanitized Outlook Event Forwarding

This is an example of what I use with my work calendar, when I need to forward something to my personal calendar.

This macro does not include any of the meeting content (who will be there, what the content is), but is just to block out the time to prevent your personal and professional lives from overlapping. This macro will create a new appointment for the time window, optionally including the subject (or replace it with [WORK]) and optionally including the location (or replace it with [WORK]).

After the invite has been sent, it deletes the invite, so it doesn't look like you've got two meetings at the same time.

It's also worth noting that you could potentially use the same code example to create a "travelling time" event before and after an appointment, if you're a person who travels to events (rather than telecommuting, you filthy animal ;) ) but I'll leave that as an exercise for the reader :)

Adding this in!

1. Press Alt+F11 in MS Outlook to open the VBA Editor, and paste the content of the other file in. Replace "example@example.com" with your email address. Note: You are likely to get a notification that Macros are disabled. You will need to OK this each time it comes up (probably each time you trigger the macro for the first time).
2. Open an outlook meeting or appointment. Right click on the ribbon, and select "Customize the ribbon...". Click on "Respond" on the "Main Tabs" block on the right, then click on "New group" and name it "Personal" (or choose your own ;) ). In the "Choose commands from" drop-down, select Macros, and then select the only macro in the box underneath. Click on the "Add >>" button in the middle. Click on "OK".

Outlook Macro.vba

' Based on https://www.slipstick.com/developer/accept-or-decline-a-meeting-request-using-vba/

Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
         
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
    Set objApp = Nothing
End Function

Sub PersonalAcceptAndForward()
On Error GoTo ErrorExit

Dim oAppt As AppointmentItem
Dim cAppt As Object
Dim meAttendee As Outlook.Recipient
Dim oResponse
Dim rMsgBox
Dim bPreserveSubject As Boolean
Dim bPreserveLocation As Boolean
Dim sSubject As String
Dim sLocation As String
 
' This next line is adjusted from the above article - it used a function that is no longer available.
Set cAppt = GetCurrentItem()
Set oAppt = Application.CreateItem(olAppointmentItem)

sSubject = cAppt.Subject
sLocation = cAppt.Location

rMsgBox = MsgBox("Subject is: " & sSubject, vbYesNo, "Preserve Subject in Forward?")
If rMsgBox = vbNo Then
  sSubject = "[Work]"
End If

rMsgBox = MsgBox("Location is: " & sLocation, vbYesNo, "Preserve Location in Forward?")
If rMsgBox = vbNo Then
  sLocation = "[Work]"
End If

With oAppt
    .MeetingStatus = olMeeting
    .Subject = sSubject
    .Start = cAppt.Start
    .Duration = cAppt.Duration
    .Location = sLocation
    Set meAttendee = .Recipients.Add("example@example.com")
     meAttendee.Type = olRequired
    .Send
End With

oAppt.Delete
 
Set cAppt = Nothing
Set oAppt = Nothing

NormalExit:
    On Error Resume Next
    Set cAppt = Nothing
    Set oAppt = Nothing
    Exit Sub

ErrorExit:
    MsgBox "Error (" & Err.Number & "): " & Err.Description
    Resume NormalExit
End Sub

Hello! Thanks so much for sharing this - it's the cleanest and most helpful macro I've found. I'm wondering how I might modify this to apply to a message invite. When I receive a new invite, I'd like to be able to use the macro from the message to accept and forward. Is that a possibility?

I'm really sorry @schlottay, both for the delay in replying (I had a surprisingly tech-free weekend!) and for the fact that I actually don't know! I actually moved away from the job where I had to use Outlook, and now my current employer is a GMail user, so I can't tell you! I will say that there's nothing I can see here which would stop you, but I'm just not sure!

No worries! Thank you for the response @JonTheNiceGuy :)