Create Outlook meeting from a shared calendar using Word VBA

Question

In a Word document a button fires a macro that creates an Outlook Meeting with the required recipients, subject line, and boilerplate body. The sender will then tweak and send.

The issue is, if I send a meeting invite and take leave from work, a co-worker cannot adjust the meeting times.

Rather than all of us sharing our calendars with full rights, I'd like to set up the meeting from a shared calendar we all have edit rights to.

The code that currently works (for my calendar):

Private Sub CommandButton900_Click()
    Dim xOutlookObj As Object
    Dim OMail As Object
    Dim xEmail As Object
    Dim xMeeting As Object
    Dim xDoc As Object
    Dim myRequiredAttendee As Outlook.Recipient
    Dim myOptionalAttendee As Outlook.Recipient

    Set xOutlookObj = CreateObject("Outlook.Application")
'I've added the following two lines from what I've found online, but I can't figure out how to reference
'objFolder when creating the Outlook meeting.
    Set objNamespace = xOutlookObj.GetNamespace("MAPI")
    Set objFolder = objNamespace.GetDefaultFolder(9).Folders("Analytics Shared")

    Set xMeeting = xOutlookObj.CreateItem(olAppointmentItem)
    Set myRequiredAttendee = xMeeting.Recipients.Add("sample.email@address")

    myRequiredAttendee.Type = olRequired

    With xMeeting
        .MeetingStatus = olMeeting
        .Display
        .Subject = "Review TELCON, "
        .Duration = 60
        xEmail.BodyFormat = olFormatHTML
        xEmail.HTMLBody = "Meeting Body" 
        xEmail.GetInspector().WordEditor.Range.FormattedText.Copy
        xMeeting.GetInspector().WordEditor.Range.FormattedText.Paste
    End With
    
    Set xDoc = Nothing
    Set xMeeting = Nothing
    Set xOutlookObj = Nothing
    Application.ScreenUpdating = True

End Sub

Answer 1

Use the NameSpace.GetSharedDefaultFolder method which returns a Folder object that represents the specified default folder for the specified user. This method is used in a delegation scenario, where one user has delegated access to another user for one or more of their default folders (for example, their shared Calendar folder).

The following code illustrates how to access the shared calendar folder:

Sub ResolveName() 
 Dim myNamespace As Outlook.NameSpace 
 Dim myRecipient As Outlook.Recipient 
 Dim CalendarFolder As Outlook.Folder 
 
 Set myNamespace = Application.GetNamespace("MAPI") 
 Set myRecipient = myNamespace.CreateRecipient("Eugene Astafiev") 
 
 myRecipient.Resolve 
 
 If myRecipient.Resolved Then 
   Call ShowCalendar(myNamespace, myRecipient) 
 End If 
End Sub 
 
Sub ShowCalendar(myNamespace, myRecipient) 
 Dim CalendarFolder As Outlook.Folder 
 
 Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)  
 CalendarFolder.Display 
 
End Sub

So, instead of using the following code for accessing the folder:

Set objFolder = objNamespace.GetDefaultFolder(9).Folders("Analytics Shared")

You can get the shared folder as shown above and then create a meeting request (or edit if required).