none
Add appointment to Exchange Rooms Calendar using VBA RRS feed

  • Question

  • I created a Rooms Calendar in Exchange server and connected to it in Outlook 2010. I now want to use automation from MS Access 2010 to add an appointment to this calendar. The problem is it don't show in the folders collection. the oNameSpace.PickFolder dialog box does not show it. Does anyone know how to access this type of calendar?
    Thursday, October 17, 2013 6:08 PM

Answers

  • Use Namespace.GetSharedDefaultFolder. You will need to have a permission to create items in that folder.

    Note that if auto accept is configured for the room mailbox, you can just send a meeting request to that mailbox.


    Dmitry Streblechenko (MVP)
    http://www.dimastr.com/redemption
    Redemption - what the Outlook
    Object Model should have been
    Version 5.5 is now available!

    • Marked as answer by Ronpaii Thursday, October 17, 2013 7:45 PM
    Thursday, October 17, 2013 6:31 PM

All replies

  • Use Namespace.GetSharedDefaultFolder. You will need to have a permission to create items in that folder.

    Note that if auto accept is configured for the room mailbox, you can just send a meeting request to that mailbox.


    Dmitry Streblechenko (MVP)
    http://www.dimastr.com/redemption
    Redemption - what the Outlook
    Object Model should have been
    Version 5.5 is now available!

    • Marked as answer by Ronpaii Thursday, October 17, 2013 7:45 PM
    Thursday, October 17, 2013 6:31 PM
  • Thanks, that gave me what I needed. Below is the code I used.

        Dim oCalendar As Outlook.Folder
        Dim oRecipient As Outlook.Recipient
        Dim oAppointment As Outlook.AppointmentItem

        Set oRecipient = oNameSpace.CreateRecipient("Company Calendar")
        oRecipient.Resolve
        If oRecipient.Resolved Then
            Set oCalendar = oNameSpace.GetSharedDefaultFolder(oRecipient, olFolderCalendar)
            Set oAppointment = oCalendar.Items.Add("IPM.Appointment")
            With oAppointment
                .Subject = "Test"
                .Body = "Hello World"
                .Location = "Here"
                dStartDate = DateAdd("d", 1, Now)
                .Start = dStartDate
                .End = DateAdd("h", 1, dStartDate)
                .ReminderSet = True
                .ReminderMinutesBeforeStart = 1
                .BusyStatus = olBusy
                .IsOnlineMeeting = False
                .Save
            End With
        Else
            MsgBox "Could not resolve: Company Calendar"
        End If

    Thursday, October 17, 2013 7:47 PM