Apply CommandBars functionality in Outlook 2013 - vba

Question

I created macros to automate the creation of new calendar appointments and to edit existing calendar appointments in Outlook 2010.
Since upgrading to Outlook 2013 the macro no longer works. I don't get any error message.
Sub NewCustomAppt()
'objects
Dim objExpl As Outlook.Explorer
Dim objFolder As Outlook.MAPIFolder
Dim objCB As Office.CommandBarButton
'appointment
Dim objAppt As Outlook.AppointmentItem
Dim objApptCustom As Outlook.AppointmentItem
Dim objOutlookAttach As Outlook.Attachment
Dim objNS
Set objNS = Application.GetNamespace("MAPI")
On Error Resume Next
Set objExpl = 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 = Application.ActiveInspector.CurrentItem
Set objApptCustom =
objFolder.Items.Add("IPM.Appointment.your_custom_class")
Set objSel = objDoc.Windows(1).Selection
With objApptCustom
.Start = objAppt.Start
.End = objAppt.End
objAppt.Location = "Careers Service, Level 6 Livingstone Tower"
objAppt.ReminderSet = True
objAppt.ReminderMinutesBeforeStart = 4320
objAppt.Body = "If you wish to cancel or re-schedule this
appointment please let us know as soon as possible, by telephone:
0141 548 4320 or email: yourcareer#strath.ac.uk." & vbNewLine & _
"" & vbNewLine & _
"Please make sure you are prompt for your appointment, if you are
more than 10 minutes late you will not be seen by the adviser."
& vbNewLine & _
& vbNewLine & _
& vbNewLine & _
"Your Careers Adviser for this appointment is:" & vbNewLine & _
"" & vbNewLine & _
"" & vbNewLine & _
In order to prepare for your appointment with your Careers Adviser
please read through the information attached below"
& vbNewLine & _
"" & vbNewLine & _
"" & vbNewLine & _
"" & vbNewLine & _
"" & vbNewLine & _
"" & vbNewLine & _
"This appointment was created on the " & Date & " at" & " " & Time
& vbNewLine & _
objAppt.Attachments.Add "I:\Admin\Careers\INTERVIEW.DOC
'Add the attachment to the e-mail message.
End With
End If
End If
End If
End Sub

Answer 1

From Microsoft:
Command bars are not used in Outlook 2013. CommandBar functions will fail silently.
Use the IRibbonExtensibility interface in an Outlook 2013 add-in instead of command bars. You can’t customize Inspector ribbons by using VBScript code behind forms.
http://technet.microsoft.com/en-us/library/cc178954%28v=office.15%29.aspx

Answer 2

.FindControl(, 1106) works in 2010 so if there is a silent fail in 2013 switch to ExecuteMso
http://msdn.microsoft.com/en-us/library/ff862419.aspx
Private Sub NewCustomAppt_ExecuteMso()
'objects
Dim objExpl As Outlook.Explorer
Dim objFolder As Outlook.Folder
'appointment
Dim objAppt As Outlook.AppointmentItem
Dim objOutlookAttach As Outlook.attachment
Dim objNS
Set objNS = Application.GetNamespace("MAPI")
Set objExpl = Application.ActiveExplorer
If Not objExpl Is Nothing Then
Set objFolder = objExpl.CurrentFolder
If objFolder.DefaultItemType = olAppointmentItem Then
objExpl.CommandBars.ExecuteMso ("NewAppointment") ' <----
Set objAppt = Application.ActiveInspector.CurrentItem
objAppt.location = "Careers Service, Level 6 Livingstone Tower"
objAppt.ReminderSet = True
objAppt.ReminderMinutesBeforeStart = 4320
objAppt.body = "If you wish to cancel or re-schedule this "
End If
End If
End Sub
The IdMso can be seen if you hover over the command when modifying ribbons or the QAT.