VBA – Ribbon Automation Via UIAutomation

I’ve made a couple posts recently about UIAutomation:

VBA - Microsoft Access Navigation Pane Automation Via UIAutomation
A recent question by a fellow MVP made me look at some old code to see if I could solve the issue using VBA UIAutomation. I’ve briefly touched upon UIAutomation in the past with articles like: So What Can UIAutomation Do For Us When It Comes To The Navigation Pane? Well, it can enable us…

Continue reading →

VBA – Microsoft Access Navigation Pane Automation Via UIAutomation Cont'd
I recently got a comment/question from Access MVP Alum George Hepworth regarding my article and YouTube video: where he inquired: Daniel, is there a method to expand or collapse the nodes inside the Nav Pane, i.e. show or hide reports under that node? Like a dog with a bone, it got me intrigued to the…

Continue reading →

Measuring Tape
VBA - UIAutomation - Is The MS Office Ribbon Expanded or Collapse?
I’ve been playing around a lot with the UIAutomation library recently and wanted to see if it would be possible to check the status of the Ribbon. Traditionally, to check if the Ribbon was Expanded or Collapsed, people rely on the height, but I don’t like that because I have no clue if that value…

Continue reading →

Spring
VBA - UIAutomation - Minimize and Maximize the Office Ribbon
Just a quick post today and sort of a Part 2 to my previous post: I thought to myself, now that I can easily and reliably determine if the Ribbon is Expanded or Collapse, wouldn’t it be useful if I could change that (thinking about changing tab and clicking on command – coming soon!). And…

Continue reading →

VBA - Find a Window By Title and Set The Focus
In my previous post: I demonstrated a simple API that we can use to bring any window to the foreground to ensure our user see it.  This is great when automating external applications to make sure the automate app in visible to the user and not hidden underneath some other program window. The problem being…

Continue reading →

and more.

I had mentioned I would give a few demonstrations of working with the Ribbon, invoking commands and that what this article is about.

Below are simply a series of procedure to accomplish a variety of different things that can be done by using the Ribbon. Demonstrations of interacting with the UI via the UIAutomationClient library.

Compact the Database

Via the Database Tools Tab

Public Function CompactCurrentDb()
    Dim UIA                   As UIAutomationClient.CUIAutomation
    Dim Access                As UIAutomationClient.IUIAutomationElement
    Dim Element               As UIAutomationClient.IUIAutomationElement
    Dim InvokePattern         As UIAutomationClient.IUIAutomationInvokePattern

    If Ribbon_ActivateTab("Database Tools") = True Then
    
        Call UIA_Ribbon_Expand 'must be maximize, displaying command buttons

        Set UIA = New CUIAutomation
        
        Set Access = UIA_Find_DbElement(Application.hWndAccessApp)

        If Not (Access Is Nothing) Then

            Set Element = UIA_FindElement(Access, "Compact and Repair Database")
            If Not (Element Is Nothing) Then
            
                Set InvokePattern = Element.GetCurrentPattern(UIA_InvokePatternId)
                InvokePattern.Invoke
            End If
        End If
    Else
        'Cannot Access the Database Tools Tab (hidden?!)
    End If

    Set InvokePattern = Nothing
    Set Element = Nothing
    Set Access = Nothing
    Set UIA = Nothing
End Function

Via the File Tab

Public Function CompactDb()
    Dim Access                As UIAutomationClient.IUIAutomationElement
    Dim ElementBS             As UIAutomationClient.IUIAutomationElement
    Dim ElementI              As UIAutomationClient.IUIAutomationElement
    Dim ElementCR             As UIAutomationClient.IUIAutomationElement
    Dim ElementBtn            As UIAutomationClient.IUIAutomationElement
    Dim TogglePattern         As UIAutomationClient.IUIAutomationTogglePattern

    Set Access = UIA_Find_DbElement(Application.hWndAccessApp)

    If Ribbon_ActivateTab("File Tab") = True Then
        If Not (Access Is Nothing) Then
            DoEvents

            Set ElementBS = UIA_FindElement_NameAndClass(Access, "Backstage view", "NetUIScrollViewer")
            Set ElementI = UIA_FindElement_NameAndClass(ElementBS, "Info", "NetUIElement")
            Set ElementCR = UIA_FindElement_NameAndClass(ElementI, "Compact & Repair", "NetUISlabContainer")

            Set ElementBtn = UIA_FindElement_NameAndClass(ElementCR, "Compact & Repair Database", "NetUIStickyButton")
            If Not (ElementBtn Is Nothing) Then

                Set TogglePattern = ElementBtn.GetCurrentPattern(UIA_TogglePatternId)
                TogglePattern.Toggle
            End If
        End If
    Else
        'Cannot Access the Database Tools Tab (hidden?!)
    End If

    Set InvokePattern = Nothing
    Set ElementBtn = Nothing
    Set Access = Nothing
End Function

Encrypt a Database

Public Function EncryptDb()
    On Error GoTo Error_Handler
    Dim oUIAAccess                As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementBS             As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementI              As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementSC             As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementBtn            As UIAutomationClient.IUIAutomationElement
    Dim oUIASelectionItemPattern As UIAutomationClient.IUIAutomationSelectionItemPattern
    Dim oUIATogglePattern     As UIAutomationClient.IUIAutomationTogglePattern
    Dim bInBackStage          As Boolean

    Set oUIAAccess = UIA_Find_DbElement(Application.hWndAccessApp)
    If Not (oUIAAccess Is Nothing) Then

        'Check For BackStage
        Set oUIAElementBS = UIA_FindElement_NameAndClass(oUIAAccess, "Backstage view", "NetUIScrollViewer")
        If Not oUIAElementBS Is Nothing Then bInBackStage = True

        If bInBackStage = False Then
            If Ribbon_ActivateTab("File Tab") = False Then
                'Couldn't locate the File tab
                Debug.Print "File Tab Not Found."
                GoTo Error_Handler_Exit
            End If
        End If

        DoEvents 'Important!

        If oUIAElementBS Is Nothing Then Set oUIAElementBS = UIA_FindElement_NameAndClass(oUIAAccess, "Backstage view", "NetUIScrollViewer")
        If Not (oUIAElementBS Is Nothing) Then

            'Find the Info Tab
            Set oUIAElementI = UIA_FindElement_NameAndClass(oUIAElementBS, "Info", "NetUIRibbonTab")
            If Not (oUIAElementI Is Nothing) Then

                'Make sure we're in the Info section
                Set oUIASelectionItemPattern = oUIAElementI.GetCurrentPattern(UIA_SelectionItemPatternId)
                If oUIASelectionItemPattern.CurrentIsSelected = False Then
                    oUIASelectionItemPattern.Select
                End If

                Set oUIAElementBtn = UIA_FindElement_NameAndClass(oUIAElementBS, "Encrypt with Password...", "NetUIStickyButton")
                If Not (oUIAElementBtn Is Nothing) Then

                    Set oUIATogglePattern = oUIAElementBtn.GetCurrentPattern(UIA_TogglePatternId)
                    oUIATogglePattern.Toggle
                End If
            End If
        End If
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oUIATogglePattern = Nothing
    Set oUIASelectionItemPattern = Nothing
    Set oUIAElementBtn = Nothing
    Set oUIAElementSC = Nothing
    Set oUIAElementI = Nothing
    Set oUIAElementBS = Nothing
    Set oUIAAccess = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: EncryptDb" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

View Account Info

Public Function ViewAccountInfo()
    On Error GoTo Error_Handler
    Dim oUIAAccess                As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementBS             As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementI              As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementSC             As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementBtn            As UIAutomationClient.IUIAutomationElement
    Dim oUIASelectionItemPattern As UIAutomationClient.IUIAutomationSelectionItemPattern
    Dim oUIATogglePattern     As UIAutomationClient.IUIAutomationTogglePattern
    Dim bInBackStage          As Boolean

    Set oUIAAccess = UIA_Find_DbElement(Application.hWndAccessApp)
    If Not (oUIAAccess Is Nothing) Then

        'Check For BackStage
        Set oUIAElementBS = UIA_FindElement_NameAndClass(oUIAAccess, "Backstage view", "NetUIScrollViewer")
        If Not oUIAElementBS Is Nothing Then bInBackStage = True

        If bInBackStage = False Then
            If Ribbon_ActivateTab("File Tab") = False Then
                'Couldn't locate the File tab
                Debug.Print "File Tab Not Found."
                GoTo Error_Handler_Exit
            End If
        End If

        DoEvents 'Important!

        If oUIAElementBS Is Nothing Then Set oUIAElementBS = UIA_FindElement_NameAndClass(oUIAAccess, "Backstage view", "NetUIScrollViewer")
        If Not (oUIAElementBS Is Nothing) Then

            'Find the Info Tab
            Set oUIAElementI = UIA_FindElement_NameAndClass(oUIAElementBS, "Account", "NetUIRibbonTab")
            If Not (oUIAElementI Is Nothing) Then
           
                'Make sure we're in the Info section
                Set oUIASelectionItemPattern = oUIAElementI.GetCurrentPattern(UIA_SelectionItemPatternId)
                If oUIASelectionItemPattern.CurrentIsSelected = False Then
                    oUIASelectionItemPattern.Select
                End If
            End If
        End If
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oUIATogglePattern = Nothing
    Set oUIASelectionItemPattern = Nothing
    Set oUIAElementBtn = Nothing
    Set oUIAElementSC = Nothing
    Set oUIAElementI = Nothing
    Set oUIAElementBS = Nothing
    Set oUIAAccess = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: ViewAccountInfo" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

View About Access From Account Info

Public Function ViewAccountAboutAccess()
    On Error GoTo Error_Handler
    Dim oUIAAccess                As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementBS             As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementI              As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementSC             As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementBtn            As UIAutomationClient.IUIAutomationElement
    Dim oUIASelectionItemPattern As UIAutomationClient.IUIAutomationSelectionItemPattern
    Dim oUIATogglePattern     As UIAutomationClient.IUIAutomationTogglePattern
    Dim bInBackStage          As Boolean

    Set oUIAAccess = UIA_Find_DbElement(Application.hWndAccessApp)
    If Not (oUIAAccess Is Nothing) Then

        'Check For BackStage
        Set oUIAElementBS = UIA_FindElement_NameAndClass(oUIAAccess, "Backstage view", "NetUIScrollViewer")
        If Not oUIAElementBS Is Nothing Then bInBackStage = True

        If bInBackStage = False Then
            If Ribbon_ActivateTab("File Tab") = False Then
                'Couldn't locate the File tab
                Debug.Print "File Tab Not Found."
                GoTo Error_Handler_Exit
            End If
        End If

        DoEvents 'Important!

        If oUIAElementBS Is Nothing Then Set oUIAElementBS = UIA_FindElement_NameAndClass(oUIAAccess, "Backstage view", "NetUIScrollViewer")
        If Not (oUIAElementBS Is Nothing) Then

            'Find the Info Tab
            Set oUIAElementI = UIA_FindElement_NameAndClass(oUIAElementBS, "Account", "NetUIRibbonTab")
            If Not (oUIAElementI Is Nothing) Then

                'Make sure we're in the Info section
                Set oUIASelectionItemPattern = oUIAElementI.GetCurrentPattern(UIA_SelectionItemPatternId)
                If oUIASelectionItemPattern.CurrentIsSelected = False Then
                    oUIASelectionItemPattern.Select
                End If
                
                DoEvents 'Important!
                
                Set oUIAElementBtn = UIA_FindElement_NameAndClass(oUIAElementBS, "About Access", "NetUIStickyButton")
                If Not (oUIAElementBtn Is Nothing) Then

                    Set oUIATogglePattern = oUIAElementBtn.GetCurrentPattern(UIA_TogglePatternId)
                    oUIATogglePattern.Toggle
                End If
            End If
        End If
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oUIATogglePattern = Nothing
    Set oUIASelectionItemPattern = Nothing
    Set oUIAElementBtn = Nothing
    Set oUIAElementSC = Nothing
    Set oUIAElementI = Nothing
    Set oUIAElementBS = Nothing
    Set oUIAAccess = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: ViewAccountAboutAccess" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Change the Theme

'Call ChangeTheme("White")
'Call ChangeTheme("Light Gray")
'Call ChangeTheme("Dark Gray")
Public Function ChangeTheme(ByVal sThemeName As String)
    On Error GoTo Error_Handler
    Dim oUIAAccess                As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementBS             As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementI              As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementSC             As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementBtn            As UIAutomationClient.IUIAutomationElement
    Dim oUIASelectionItemPattern As UIAutomationClient.IUIAutomationSelectionItemPattern
    Dim oUIATogglePattern     As UIAutomationClient.IUIAutomationTogglePattern
    Dim bInBackStage          As Boolean

    Set oUIAAccess = UIA_Find_DbElement(Application.hWndAccessApp)
    If Not (oUIAAccess Is Nothing) Then

        'Check For BackStage
        Set oUIAElementBS = UIA_FindElement_NameAndClass(oUIAAccess, "Backstage view", "NetUIScrollViewer")
        If Not oUIAElementBS Is Nothing Then bInBackStage = True

        If bInBackStage = False Then
            If Ribbon_ActivateTab("File Tab") = False Then
                'Couldn't locate the File tab
                Debug.Print "File Tab Not Found."
                GoTo Error_Handler_Exit
            End If
        End If

        DoEvents 'Important!

        If oUIAElementBS Is Nothing Then Set oUIAElementBS = UIA_FindElement_NameAndClass(oUIAAccess, "Backstage view", "NetUIScrollViewer")
        If Not (oUIAElementBS Is Nothing) Then

            'Find the Info Tab
            Set oUIAElementI = UIA_FindElement_NameAndClass(oUIAElementBS, "Account", "NetUIRibbonTab")
            If Not (oUIAElementI Is Nothing) Then

                'Make sure we're in the Info section
                Set oUIASelectionItemPattern = oUIAElementI.GetCurrentPattern(UIA_SelectionItemPatternId)
                If oUIASelectionItemPattern.CurrentIsSelected = False Then
                    oUIASelectionItemPattern.Select
                End If
                
                DoEvents 'Important!
                
                'Get CBO
                Dim el As UIAutomationClient.IUIAutomationElement
                Set el = UIA_FindElement_NameAndClass(oUIAElementBS, "Office Theme:", "NetUIDropdownAnchor")
                'Current Value
                If sThemeName = el.GetCurrentPropertyValue(UIA_ValueValuePropertyId) Then GoTo Error_Handler_Exit
               
                Dim oEl As UIAutomationClient.IUIAutomationExpandCollapsePattern
                Set oEl = el.GetCurrentPattern(UIA_ExpandCollapsePatternId)
                oEl.Expand

                Dim el3 As UIAutomationClient.IUIAutomationElement
                Set el3 = UIA_FindElement_NameAndClass(oUIAElementBS, sThemeName, "NetUIGalleryButton")
                
                Dim InvokePattern         As UIAutomationClient.IUIAutomationInvokePattern
                Set InvokePattern = el3.GetCurrentPattern(UIA_InvokePatternId)
                InvokePattern.Invoke
            End If
        End If
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oUIATogglePattern = Nothing
    Set oUIASelectionItemPattern = Nothing
    Set oUIAElementBtn = Nothing
    Set oUIAElementSC = Nothing
    Set oUIAElementI = Nothing
    Set oUIAElementBS = Nothing
    Set oUIAAccess = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: ChangeTheme" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Open the Database Options Dialog

Public Function ViewOptions()
    On Error GoTo Error_Handler
    Dim oUIAAccess            As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementBS         As UIAutomationClient.IUIAutomationElement
    Dim oUIAElementO          As UIAutomationClient.IUIAutomationElement
    Dim oLegacyIAccessiblePattern As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
    Dim bInBackStage          As Boolean

    Set oUIAAccess = UIA_Find_DbElement(Application.hWndAccessApp)
    If Not (oUIAAccess Is Nothing) Then

        'Check For BackStage
        Set oUIAElementBS = UIA_FindElement_NameAndClass(oUIAAccess, "Backstage view", "NetUIScrollViewer")
        If Not oUIAElementBS Is Nothing Then bInBackStage = True

        If bInBackStage = False Then
            If Ribbon_ActivateTab("File Tab") = False Then
                'Couldn't locate the File tab
                Debug.Print "File Tab Not Found."
                GoTo Error_Handler_Exit
            End If
        End If

        DoEvents    'Important!

        'Find the BackStage
        If oUIAElementBS Is Nothing Then
            Set oUIAElementBS = UIA_FindElement_NameAndClass(oUIAAccess, "Backstage view", "NetUIScrollViewer")
        End If
        If Not (oUIAElementBS Is Nothing) Then

            'Find the Options Button
            Set oUIAElementO = UIA_FindElement_NameAndClass(oUIAElementBS, "Options", "NetUIOutSpaceButton")
            'https://learn.microsoft.com/en-us/windows/win32/winauto/uiauto-supportmenuitemcontroltype
            If Not (oUIAElementO Is Nothing) Then

                'Click the Options Button
                Set oLegacyIAccessiblePattern = oUIAElementO.GetCurrentPattern(UIA_LegacyIAccessiblePatternId)
                oLegacyIAccessiblePattern.DoDefaultAction
                '***** All code gets halted at this point until the Options dialog is close! *****
            End If
        End If
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oLegacyIAccessiblePattern = Nothing
    Set oUIAElementO = Nothing
    Set oUIAElementBS = Nothing
    Set oUIAAccess = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: ViewOptions" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

So I hope these procedures offer a little insight on how UIAutomation can be used to interact with the UI (as the name implies).

Resources on the Subject

Control Type Identifiers (UIAutomationClient.h) - Win32 apps
This topic describes the named constants used to identify Microsoft UI Automation control types.

3 responses on “VBA – Ribbon Automation Via UIAutomation”

  1. Angel Mazo

    Hi Daniel,
    Thank you very much for wonderful info you are so kind to share with us.
    I have a problem because in other languages (as Spanish one) is complicated guess how terms as “Backstage view” has been translated by Microsoft.
    Ok, it is easy to make a language translation but it is not to know what, exactly, should replace those terms.
    How could I do it?
    Regards,

    1. Daniel Pineault Post author

      There’s no listing that I know of, so you’d have to breakdown the UI element listing on installations with different locales/languages and build your own list.

      Another possibility, but not sure if it would be unique enough to work, but perhaps instead of binding to the Name, we could instead search and bind to the Class. That would only be viable is there is only 1 element with that class, otherwise it would be useless.

      1. Daniel Pineault Post author

        I did a quick check, far from thoroughly tested, but when you’re on the File Tab the backstage seems to be the only element with the class ‘NetUIScrollViewer’ so searching and binding by class, in this instance, may work.