Calling Ribbon Button in Outlook 2016

Status
Not open for further replies.

Wayne Dardis

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server 2013
I am not a VBA programmer. The following is the main sub of a project that I cobbled together for Outlook 2007 and was pleased to find it worked for Outlook 2010 a few years later. However, we are moving to Outlook 2016 now and I've found that it does not work as intended.

We have displays outside our meeting rooms that show the schedules for those rooms in the form of Outlook calendars. I've set a recurring appointment with a reminder just after midnight every day. The reminder event triggers this code. From what I've seen, I think that trigger part still works because "ReminderObject.Dismiss" seems to dismiss the reminder. (I don't see it pop up at all.) However, the main purpose of the code fails, and that is to switch the calendar view to the current date, "Go To Today."

I think this might have something to do with the "Go To Today" button existing on the Ribbon or Home Tab or Whateveritiscallednow instead of on the old command menu. So, maybe the syntax of "objExpl.CommandBars.FindControl" etc. has to change?

From what I picked up from Download Office 2016 Help Files: Office Fluent User Interface Control Identifiers from Official Microsoft Download Center , outlookexplorercontrols.xlsx , Row 187 ... The ID for "Today" is still "5497."

Anyway here is the sub as originally cobbled together. Maybe just looking at it will make my trouble clear to someone fluent in this language...

--- --- --- ---
Private Sub m_colReminders_ReminderFire(ByVal ReminderObject As Outlook.Reminder)

Dim objOL As Outlook.Application
Dim objExpl As Outlook.Explorer
Dim objCBB As Office.CommandBarButton
Const cbbThisDayID = 5497
On Error Resume Next​

Set objOL = CreateObject("Outlook.Application")
Set objExpl = objOL.ActiveExplorer
If objExpl.CurrentFolder.DefaultItemType = olAppointmentItem Then
Set objCBB = objExpl.CommandBars.FindControl(, cbbThisDayID)
objCBB.Execute​
End If
Set objOL = Nothing
Set objExpl = Nothing
Set objCBB = Nothing
ReminderObject.Dismiss​
End Sub
--- --- --- ---

Thank you in advance for your time and assistance!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
I don't think the location of the button matters - it uses the command id or name, not the sendkeys (which would be affected by the location).


This is messy but accomplishes the same thing by switching to the inbox and back to the calendar.

Code:
'Private Sub m_colReminders_ReminderFire(ByVal ReminderObject As Outlook.Reminder)
Private Sub Application_Reminder(ByVal Item As Object)

    Dim objPane As Outlook.NavigationPane
    Dim objCalModule As Outlook.CalendarModule
    Dim objMailModule As Outlook.MailModule
    Dim objNavFolder As Outlook.NavigationFolder

Dim objOL As Outlook.Application
Dim objExpl As Outlook.Explorer
Dim objCBB As Office.CommandBarButton
'On Error Resume Next
Set objOL = CreateObject("Outlook.Application")
Set objExpl = objOL.ActiveExplorer
If objExpl.CurrentFolder.DefaultItemType = olAppointmentItem Then
  
Set objPane = objOL.ActiveExplorer.NavigationPane
   Set objMailModule = objPane.Modules.GetNavigationModule(olModuleMail)
    Set objPane.CurrentModule = objMailModule

  Set objCalModule = objPane.Modules.GetNavigationModule(olModuleCalendar)
    Set objPane.CurrentModule = objCalModule

End If
Set objOL = Nothing
Set objExpl = Nothing
Set objCBB = Nothing
'ReminderObject.Dismiss
End Sub
 

Wayne Dardis

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server 2013
Thank you for the thoughtful reply. I won't be able to try it out until tomorrow sometime, but I do want to clarify...

Is still possible to trigger the command with ID, 5497... "Go To Today" in Outlook 2016?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
I thought CommandBars.FindControl should still work, although it is deprecated and not the recommended method anymore, but it didn't work for me either. If Michael is around, he might know.
 

Wayne Dardis

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server 2013
I guess Michael isn't around.

Anyway, Diane, I have a question for you... I pasted the code you suggested into my editor and then noticed that you put single quote marks at the beginning of 3 lines:

'Private Sub m_colReminders_ReminderFire(ByVal ReminderObject As Outlook.Reminder)
'On Error Resume Next
'ReminderObject.Dismiss

This appears to have the effect of treating those lines as comments and so they are ignored. I'm not sure if the first two matter, but the last one I'm pretty sure is necessary. I do want the reminder to be dismissed at the end of the process.

Did you intend to comment-out these three lines? If so, why not just remove them entirely?

Thank you again so very much!
 

Wayne Dardis

New Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server 2013
It seems I figured out what to do and it works here's the code for the entire class module:
Code:
Dim WithEvents m_colReminders As Outlook.Reminders
Dim m_intBusyStatus As Integer

Private Sub Class_Terminate()
    Call DeRefReminders
End Sub
Public Sub InitReminders(objApp As Outlook.Application)
    Set m_colReminders = objApp.Reminders
    m_intBusyStaus = 0
End Sub
Public Sub DeRefReminders()
    Set m_colReminders = Nothing
End Sub
Private Sub m_colReminders_ReminderFire(ByVal ReminderObject As Outlook.Reminder)

    Dim objPane As Outlook.NavigationPane
    Dim objCalModule As Outlook.CalendarModule
    Dim objMailModule As Outlook.MailModule
    Dim objNavFolder As Outlook.NavigationFolder

Dim objOL As Outlook.Application
Dim objExpl As Outlook.Explorer
Dim objCBB As Office.CommandBarButton
On Error Resume Next
Set objOL = CreateObject("Outlook.Application")
Set objExpl = objOL.ActiveExplorer
If objExpl.CurrentFolder.DefaultItemType = olAppointmentItem Then
 
Set objPane = objOL.ActiveExplorer.NavigationPane
   Set objMailModule = objPane.Modules.GetNavigationModule(olModuleMail)
    Set objPane.CurrentModule = objMailModule

  Set objCalModule = objPane.Modules.GetNavigationModule(olModuleCalendar)
    Set objPane.CurrentModule = objCalModule

End If
Set objOL = Nothing
Set objExpl = Nothing
Set objCBB = Nothing
ReminderObject.Dismiss
End Sub
Thank you VERY much!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Anyway, Diane, I have a question for you... I pasted the code you suggested into my editor and then noticed that you put single quote marks at the beginning of 3 lines:
i needed to comment them out for my test - one was to change the name of the macro, one was so i'm notified of errors and since i wasn't setting the reminderobject, needed to turn that off too. :)
 
Status
Not open for further replies.
Top