How can I macro Appointment creation in Outlook 2013 with user selected times for pre-set Subjects?

Question

I have a very nice VBA appointment macro I found posted online ages ago for creating new appointments with pre-set parameters at a user selected time and date in the calendar.

It worked so well in Office 2007, but then we were recently moved to Office 2013 for an institutional shift to using Office 365 Enterprise (Educational). And it totally broke. Permissions are fine so it is actually running (finally: tested via stepping into it via debugger) but it's still not doing anything… not even throwing errors.

Here's the code for the macro:

Private Sub CreateAppt(strSubject, strCategories, strLocation, strBody, bolRemindMe, intRemindMe)

    Dim objExpl As Outlook.Explorer
    Dim objFolder As Outlook.MAPIFolder
    Dim objCB As Office.CommandBarButton
    Dim objAppt As Outlook.AppointmentItem
    Dim objApptCustom As Outlook.AppointmentItem
    On Error Resume Next

    Set objExpl = Outlook.Application.ActiveExplorer
    If Not objExpl Is Nothing Then
        Set objFolder = objExpl.CurrentFolder
        If objFolder.DefaultItemType = olAppointmentItem Then
            Set objCB = objExpl.CommandBars.FindControl(, 1106)
            If Not objCB Is Nothing Then
                objCB.Execute
                Set objAppt = Outlook.Application.ActiveInspector.CurrentItem
                Set objApptCustom = objFolder.Items.Add(olAppointmentItem)
                With objApptCustom
                    .Start = objAppt.Start
                    .End = objAppt.End
                    .Subject = strSubject
                    .Location = strLocation
                    .Categories = strCategories
                    .ReminderSet = bolRemindMe
                    .Body = strBody
                    If bolRemindMe = True Then
                        .ReminderMinutesBeforeStart = intRemindMe
                    End If
                    .Save
                End With
                objAppt.Delete
            End If
        End If
    End If

    Set objCB = Nothing
    Set objAppt = Nothing
    Set objApptCustom = Nothing
    Set objFolder = Nothing
    Set objExpl = Nothing

End Sub

This was called by exposed macros that populated the function's parameters appropriately, for example:

Sub NewSupport()

Call CreateAppt("CMS Open Support", "Support", "Roberts 109", "", True, 20)

End Sub

I've tried explicitly referencing the Outlook.Application for the ActiveInspector, I've tried using the global supplied constant (olAppointmentItem) for an Item type instead of the string "IPM.Appointment".

I've also tried using some code to iterate through available Commands and CommandBars, in case the ID for Commandbars.FindControl(, 1106) changed between versions, and all I'm getting back is "Task Pane" under Inspector for Appointment, with ID 5746.

I feel like I'm running out of ideas: even just something pointing me in the right direction for new things to try would be great at this point.

Recurring appointments won't work, as those require some form of regular structure to the recurrence, which isn't the case for this.

A custom form might be a solution, but I really prefer just being able to click a single button to schedule that span of time for the specific appointment "type" and never having to even open the appointment directly at all.

Answer 1

The problem with Office 2007 macro code relying on CommandBar actions is that Office 2010 and forward no longer use CommandBars.

This Office DevCenter article describes how to update code that previously relied on CommandBars to instead use the ribbon extensibility. Yay, deprecation!

But wait! Before we tread down that path of refactoring, let's revisit why the macro is using CommandBars in the first place: in Office 2007 and prior, there was no way to get enough information back from a user selection itself—you could only operate on items themselves within the selection, which doesn't work for finding the start and stop times of a blank span of time that has been selected in the Calendar.

So the macro was relying on firing a New Appointment from the menu (called using CommandBars), which would automatically be populating the start and stop time from the user selection because that's how the New Appointment command from the Outlook menu works.

Office 2010 apparently changed that.

You can now directly reference user selections of [blank] spans of time made in the Calendar pane.

All we need to do is take the .SelectedStartTime and .SelectedEndTime from the CalendarView and apply them to our new Appointment. The CalendarView.SelectedStartTime Property (Outlook) article in the Office Dev Center not only lays this out explicitly, but even comes with example code.

Some light modifications to that code result in a private sub that we can use as a drop in for the previous macro, to be called by the publicly exposed specific macros.

The code below has minor changes from the code originally detailed in that page, which are: adding parameters, adding the With segment to apply them, and saving the new appointment directly to the calendar instead of only opening it for view/editing. And slightly better formatting.

Private Sub CreateAppointmentUsingSelectedTime(strSubject, strCategories, strLocation, strBody, bolRemindMe, intRemindMe)
 Dim datStart As Date
 Dim datEnd As Date
 Dim oView As Outlook.View
 Dim oCalView As Outlook.CalendarView
 Dim oExpl As Outlook.Explorer
 Dim oFolder As Outlook.Folder
 Dim oAppt As Outlook.AppointmentItem
 Const datNull As Date = #1/1/4501#

 ' Obtain the calendar view using
 ' Application.ActiveExplorer.CurrentFolder.CurrentView.
 ' If you use oExpl.CurrentFolder.CurrentView,
 ' this code will not operate as expected.
 Set oExpl = Application.ActiveExplorer
 Set oFolder = Application.ActiveExplorer.CurrentFolder
 Set oView = oExpl.CurrentView

 ' Check whether the active explorer is displaying a calendar view.
 If oView.ViewType = olCalendarView Then
    Set oCalView = oExpl.CurrentView
    ' Create the appointment using the values in
    ' the SelectedStartTime and SelectedEndTime properties as
    ' appointment start and end times.
    datStart = oCalView.SelectedStartTime
    datEnd = oCalView.SelectedEndTime
    Set oAppt = oFolder.Items.Add("IPM.Appointment")
    With oAppt
       .Subject = strSubject
       .Location = strLocation
       .Categories = strCategories
       .ReminderSet = bolRemindMe
       .Body = strBody
       If bolRemindMe = True Then
           .ReminderMinutesBeforeStart = intRemindMe
       End If
    End With
    If datStart <> datNull And datEnd <> datNull Then
       oAppt.Start = datStart
       oAppt.End = datEnd
    End If
    oAppt.Save
    ' oAppt.Display
 End If
End Sub

Hopefully this helps someone else, because I spent far longer (mostly futiley searching, hence being about to post this as just a question before finally isolating the issues and solution) on it than I expected to, or even than it probably will ever save me, time-wise, in creating new pre-set appointments!