HOW TO: Manipulating Office Ribbon Bar only with VBA

Applies to Office 2007, 2010 and 2013

Actual Situation
In older MS Office versions, menu items could be added and manipulated by the VBA CommandBars object.

Since Microsoft introduced the ribbon bars into office beginning with Office 2007, all the items created by the CommandBar object are placed into the AddIns Menu.  There is no object anymore to add your own menu item with your own groups directly from VBA.

Nevertheless you can create your own menu items and groups using the File – Options menu in your office application. The result of such changes is now, that an XML file is created, which is placed into the UserProfile\AppData\local\Microsoft\Office  folder.

The files are named as ApplicationName.officeUI

The Problem
I usually write some setup routines in VBA to simplify the implementation of such macros into an user environment. Such setup routines also include the implementation of an icon somewhere to call the macro. But just to create an additional menu with some submenus or ribbon groups is not quite easy anymore, so the question is, how to realize this again only by using VBA.

The Idea
So I started to think about to directly modify the XML file using VBA. There is only a small lack of this procedure, as the office application has to be closed and reopened again, but this I can live with.

The solution
I want to provide you with some sample code, which reads the XML file, extract the existing content and place your own items between them. As far as no user defined items exist, the code just generates the file and puts everything into the file, what is needed to show the menu items.

What you have to change in the code
The easiest way to find out, what to chance in the example code, just go to File-Options in your Office Application, customize your Ribbon bar as needed, so place a menu item, a group and your macro there with the icons you want to use and then inspect the created XML file in the folder described above and fish out the values, you want to place into the macro.

In the sample code, you have to change:

1.) Private Const OfficeApplicationFileName As String = "MSProject.officeUI"

Put here the file name, which is created by your customized ribbon bar. In this example it is taken from MS Project 2010.

2.) Goto “Define the new menu item, menu group and button for the macro”

You may replace the values by your own values for

• MyMenuItemIdentifier
• MyMenuLabel
• MyMenuGroupIdentifier
• MyGroupLabel
• MyButtonIdentifier
• MyMacroLabel

From the created XML file you can take over the values for

• imageMso
• onAction (this is the name of your macro)

Test
That it, with a little bit fantasy, you may enlarge it as needed.
Just run the Macro Setup_MyOwnButton and see what happens
You have to close and reopen your office application to see it.

How to remove it again
If you don’t like it, you can just remove it as you manually created it. Just go to Files-Options and remove it from the menu bar. Removing the  xxx. officeUI XML file just resets all menus to the default.

Option Explicit

'Declaration needed for shfolder
Private Const SHGFP_TYPE_CURRENT = 0
Private Const CSIDL_LOCAL_APPDATA = &H1C

Private Declare Function SHGetFolderPath Lib "shfolder" Alias "SHGetFolderPathA" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, ByVal dwFlags As Long, ByVal pszPath As String) As Long

'Put your application name in here
Private Const OfficeApplicationFileName As String = "MSProject.officeUI"

Public Sub Setup_MyOwnButton()
    Dim FilePath As String
    Dim CurrentXML As String
    Dim ribbonXMLHeader As String
    Dim ribbonXMLContent As String
    Dim ribbonXMLNew As String
    Dim ribbonXMLFooter As String
    Dim XPos1 As Long
    Dim XPos2 As Long
    Dim X As Long
    Dim retVal As Long
    
    'Read current path, where the files are placed
    FilePath = String(255, vbNullChar)
    retVal = SHGetFolderPath(0, CSIDL_LOCAL_APPDATA, 0, SHGFP_TYPE_CURRENT, FilePath)
    FilePath = Left(FilePath, InStr(1, FilePath, Chr(0)) - 1)
    FilePath = FilePath & "\Microsoft\Office\" & OfficeApplicationFileName
    
    CurrentXML = ""
    If ExistsFile(FilePath) Then
    
        'Read the content of the CustomUI file, if exists
        X = FreeFile
        Open FilePath For Input As #X
        Input #X, CurrentXML
        Close #X
        
        'Extract the header, footer and actual content from the XML file
        XPos1 = InStr(CurrentXML, "<mso:tabs>") + Len("<mso:tabs>") - 1
        XPos2 = InStr(CurrentXML, "</mso:tabs>")

        If XPos1 > 0 Then
            ribbonXMLHeader = Left$(CurrentXML, XPos1)
        End If
        If XPos2 > 0 Then
            ribbonXMLFooter = Mid$(CurrentXML, XPos2)
        End If
        If XPos1 > 0 And XPos2 > 0 Then
            ribbonXMLContent = Mid$(CurrentXML, XPos1 + 1, Len(CurrentXML) - XPos1 - Len(ribbonXMLFooter))
        End If
        
    Else
        'Create a new Header and footer
        ribbonXMLHeader = "<mso:customUI xmlns:x2=""http://schemas.microsoft.com/office/2009/07/customui/macro"""
        ribbonXMLHeader = ribbonXMLHeader + " xmlns:x1=""TFCOfficeShim.Connect.3"""
        ribbonXMLHeader = ribbonXMLHeader + " xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">"
        ribbonXMLHeader = ribbonXMLHeader + "<mso:ribbon>"
        ribbonXMLHeader = ribbonXMLHeader + "<mso:qat/>"
        ribbonXMLHeader = ribbonXMLHeader + "<mso:tabs>"
    
        ribbonXMLFooter = ribbonXMLFooter + "</mso:tabs>"
        ribbonXMLFooter = ribbonXMLFooter + "</mso:ribbon>"
        ribbonXMLFooter = ribbonXMLFooter + "</mso:customUI>"
    
    End If
    
    'Define the new menu item, menu group and button for the macro
    'ID has to be unique, but you can use any name
    'Label is just your name
    'imageMso is the name of an existing application icon, create it one time via File-Options to find your icons.
    'onAction is the Name of your Macro
    
    ribbonXMLNew = ribbonXMLNew + "<mso:tab id=""MyMenuItemIdentifier"" label=""MyMenuLabel"" insertBeforeQ=""mso:TabFormat"">"
    ribbonXMLNew = ribbonXMLNew + "<mso:group id=""MyMenuGroupIdentifier"" label=""MyGroupLabel"" imageMso=""ShowClipboard"" autoScale=""true"">"
    ribbonXMLNew = ribbonXMLNew + "<mso:button id=""MyButtonIdentifier"" label=""MyMacroLabel"" "
    ribbonXMLNew = ribbonXMLNew + "imageMso=""HyperlinksVerify"" onAction=""NameOfMyMacro"" visible=""true""/>"
    ribbonXMLNew = ribbonXMLNew + "</mso:group></mso:tab>"
    
    'Add the new content to the existing content if exists
    XPos1 = InStr(ribbonXMLContent, ribbonXMLNew)
    If XPos1 > 0 Then
        ribbonXMLContent = Left$(ribbonXMLContent, XPos1 - 1) & Mid$(ribbonXMLContent, XPos1 + Len(ribbonXMLNew))
        ribbonXMLContent = ribbonXMLContent + ribbonXMLNew
    Else
        ribbonXMLContent = ribbonXMLContent + ribbonXMLNew
    End If
    

    'Write the new XML
    X = FreeFile
    Open FilePath For Output As X
       Print #X, ribbonXMLHeader + ribbonXMLContent + ribbonXMLFooter
    Close #X

    MsgBox "Please close the application and reopen it again", vbInformation, "My Setup Tool"

End Sub

'******************************************************************************
'Helper Macros
Public Function ExistsFile(wwFile As String) As Boolean
Dim ret As Long
On Error Resume Next
    ret = GetAttr(wwFile)
    If Err = 0 Or Err = 70 Then
        ExistsFile = True
    Else
        ExistsFile = False
    End If
    Err = 0
End Function