Sorting & Filtering when using Access Runtime 2010

[Carmine]

I have a small Access Data base I’m distributing to friends using the 2010 Access Runtime environment. However the Runtime environment eliminates the Access right mouse button, sorting, filtering features. Is there any way to write these features into the DB using VBA?



Given that I'm a newbie, I probably will be copying and pasting any code suggestions.

Thanks in advance,

Carmine

[CJ_London]

you can try cutting and pasting this code into a module. It creates a number of basic shortcut menus for DAO and ADO recordsets - I'm guessing you wont need the ADO ones.

I haven't used it for many years, so hopefully it will work for you - I don't have time to do any debugging.

The menus only need to be created once for each application. Once done, for each control in each form you want to be able filter/sort, put the name of the relevant shortcut in the shortcut menu bar property (on the Other tab). Use the one relevant to the field type of the controlsource - so for text, use daoDSText, a date daoDSDate., etc.

You may not be aware, but if you change the filetype from .accdb to .accdr you can then test under runtime conditions

Function CreateMenus()'call once on db startup - creates shortcut menus
Dim newBar As Object 'CommandBar
Dim newItem As Object 'CommandBarButton
Dim barType As Integer
Dim BarName As String
Dim DSType As Integer
Const msoBarPopup = 5
Const msoControlButton = 1
Const msoButtonCaption = 2




'Set newBar = Application.CommandBars("CommandBar")
'Set newItem = Application.CommandBars("CommandBarButton")


    On Error GoTo errctrl
         
    For DSType = 0 To 1 '0=DAO, 1=ADO
        
        For barType = 1 To 4
            
            'set name for menubar
            BarName = Choose(barType + (DSType * 4), "daoDSText", "daoDSDate", "daoDSNum", "daoDSCol", "adoDSText", "adoDSDate", "adoDSNum", "adoDSCol")
            
            'If menu with same name exists then delete it
            CommandBars(BarName).Delete
            
        
            Set newBar = CommandBars.Add(BarName, msoBarPopup, False, False)
            'newBar.Controls.Add Type:=msoControlButton, id:=3077
            newBar.Controls.Add ID:=3077
            newBar.Controls.Add ID:=14205
            Select Case DSType
                Case 0 'DAO 'msoBarTypeMenuBar
                    newBar.Controls.Add Type:=msoControlButton, ID:=210 ', Style:=msoButtonAutomatic   'SortUp
                Case 1 'ADO
                        Set newItem = newBar.Controls.Add(msoControlButton)
                        newItem.Caption = "Sort Ascending"
                        newItem.OnAction = "=adoSort(-1)"
                        newItem.Style = msoButtonCaption
            End Select
            
            Select Case DSType
                Case 0 'DAO
                    newBar.Controls.Add Type:=msoControlButton, ID:=211 ', Style:=msoButtonAutomatic    'SortDown
                Case 1 'ADO
                    Set newItem = newBar.Controls.Add(msoControlButton)
                    newItem.Caption = "Sort Descending"
                    newItem.OnAction = "=adoSort(0)"
                    newItem.Style = msoButtonCaption
            End Select
            
            'newBar.Controls.Add Type:=msoControlButton, Id:=1955   'RecordsHideColumns - replaced with new item/can be selected from unhide list
            'newBar.Controls.Add Type:=msoControlButton, id:=2764   'RecordsUnhideColumns - replaced with new item - not new item only for Usysform
            
            Set newItem = newBar.Controls.Add(msoControlButton)     'Hide/unhide columns based on recordset rather than controls
            newItem.Caption = "&Unhide/Hide Columns"
            newItem.OnAction = "=hideunhide([Form])"
            newItem.Style = msoButtonCaption
            
            newBar.Controls.Add Type:=msoControlButton, ID:=544    'RecordsFreezeColumns
            newBar.Controls.Add Type:=msoControlButton, ID:=1794   'RecordsUnfreeze
        
        If BarName Like "*DS*" Then
            Select Case DSType
                Case 0 'DAO
                    newBar.Controls.Add Type:=msoControlButton, ID:=12267  'SortRemoveAllSorts
                Case 1 'ADO
                    Set newItem = newBar.Controls.Add(msoControlButton)
                    newItem.Caption = "Sort Remove Sort"
                    newItem.OnAction = "=adoSort(1)"
                    newItem.Style = msoButtonCaption
            End Select
            
            Select Case DSType
                Case 0 'DAO
                    newBar.Controls.Add Type:=msoControlButton, ID:=11761  'GroupSortAndFilter
                Case 1 'ADO
                    'what to put here?
            End Select
            
            'newBar.Controls.Add Type:=msoControlButton, Id:=499    'SortAndFilterAdvanced - why not included?
            'newBar.Controls.Add Type:=msoControlButton, id:=605    'FilterClearAllFilters - why not included?
            'newBar.Controls.Add Type:=msoControlButton, Id:=13278    'FilterAdvancedMenu - why not included?
            
            Select Case DSType
                Case 0 'DAO
                    newBar.Controls.Add Type:=msoControlButton, ID:=10071  'FilterRemoveSelection
                Case 1 'ADO
                    Set newItem = newBar.Controls.Add(msoControlButton)
                    newItem.Caption = "Filter Remove Selection"
                    newItem.OnAction = "=adoAllFilter(0)"
                    newItem.Style = msoButtonCaption
            End Select
            
            Select Case DSType
                Case 0 'DAO
                    newBar.Controls.Add Type:=msoControlButton, ID:=10068  'FilterEqualsSelection
                Case 1 'ADO
                    Set newItem = newBar.Controls.Add(msoControlButton)
                    newItem.Caption = "Filter Equals Selection"
                    newItem.OnAction = "=adoAllFilter(1)"
                    newItem.Style = msoButtonCaption
            End Select
            
            Select Case DSType
                Case 0 'DAO
                    newBar.Controls.Add Type:=msoControlButton, ID:=10071  'FilterNotEqualsSelection
                Case 1 'ADO
                    Set newItem = newBar.Controls.Add(msoControlButton)
                    newItem.Caption = "Filter Does Not Equal Selection"
                    newItem.OnAction = "=adoAllFilter(2)"
                    newItem.Style = msoButtonCaption
            End Select
           
           
           '_____________________________ all the same to here for all controltypes
            
            Select Case barType
                Case 1: 'text
                    Select Case DSType
                        Case 0 'DAO
                            newBar.Controls.Add Type:=msoControlButton, ID:=10076  'FilterContainsSelection
                        Case 1 'ADO
                            Set newItem = newBar.Controls.Add(msoControlButton)
                            newItem.Caption = "Filter Contains Selection"
                            newItem.OnAction = "=adoTxtFilter(1)"
                            newItem.Style = msoButtonCaption
                    End Select
                    
                    Select Case DSType
                        Case 0 'DAO
                            newBar.Controls.Add Type:=msoControlButton, ID:=10089  'FilterDoesNotContainSelection
                        Case 1 'ADO
                            'Set newItem = newBar.Controls.Add(msoControlButton) ???why not working???
                            'newItem.Caption = "Filter Does Not Contain Selection"
                            'newItem.OnAction = "=adoTxtFilter(2)"
                            'newItem.Style = msoButtonCaption
                    End Select
                    
                    Select Case DSType
                        Case 0 'DAO
                            newBar.Controls.Add Type:=msoControlButton, ID:=10090  'FilterBeginsWithSelection
                        Case 1 'ADO
                            Set newItem = newBar.Controls.Add(msoControlButton)
                            newItem.Caption = "Filter Begins With Selection"
                            newItem.OnAction = "=adoTxtFilter(3)"
                            newItem.Style = msoButtonCaption
                    End Select
                    
                    Select Case DSType
                        Case 0 'DAO
                            newBar.Controls.Add Type:=msoControlButton, ID:=12265  'FilterDoesNotBeginWithSelection
                        Case 1 'ADO
                            'Set newItem = newBar.Controls.Add(msoControlButton)
                            'newItem.Caption = "Filter Does Not Begin With Selection"
                            'newItem.OnAction = "=adoTxtFilter(4)"
                            'newItem.Style = msoButtonCaption
                    End Select
                    
                    Select Case DSType
                        Case 0 'DAO
                            newBar.Controls.Add Type:=msoControlButton, ID:=10091  'FilterEndsWithSelection
                        Case 1 'ADO
                            'Set newItem = newBar.Controls.Add(msoControlButton)
                            'newItem.Caption = "Filter Ends With Selection"
                            'newItem.OnAction = "=adoTxtFilter(5)"
                            'newItem.Style = msoButtonCaption
                    End Select
                    
                    Select Case DSType
                        Case 0 'DAO
                            newBar.Controls.Add Type:=msoControlButton, ID:=12266  'FilterDoesNotEndWithSelection
                        Case 1 'ADO
                            'Set newItem = newBar.Controls.Add(msoControlButton)
                            'newItem.Caption = "Filter Does Not End With Selection"
                            'newItem.OnAction = "=adoTxtFilter(6)"
                            'newItem.Style = msoButtonCaption
                    End Select
                        
                Case 2: 'dates
                    Select Case DSType
                        Case 0 'DAO
                            newBar.Controls.Add Type:=msoControlButton, ID:=10092  'FilterBeforeSelection
                        Case 1 'ADO
                            Set newItem = newBar.Controls.Add(msoControlButton)
                            newItem.Caption = "Filter <= Selection"
                            newItem.OnAction = "=adoNumFilter(1)"
                            newItem.Style = msoButtonCaption
                    End Select
                    
                    Select Case DSType
                        Case 0 'DAO
                            newBar.Controls.Add Type:=msoControlButton, ID:=10093  'FilterAfterSelection
                        Case 1 'ADO
                            Set newItem = newBar.Controls.Add(msoControlButton)
                            newItem.Caption = "Filter >= Selection"
                            newItem.OnAction = "=adoNumFilter(2)"
                            newItem.Style = msoButtonCaption
                    End Select
                    
                Case 3: 'dates and numbers
                    Select Case DSType
                        Case 0 'DAO
                            newBar.Controls.Add Type:=msoControlButton, ID:=10095  'FilterSmallerThanSelection
                        Case 1 'ADO
                            Set newItem = newBar.Controls.Add(msoControlButton)
                            newItem.Caption = "Filter <= Selection"
                            newItem.OnAction = "=adoNumFilter(1)"
                            newItem.Style = msoButtonCaption
                    End Select
                    
                    Select Case DSType
                        Case 0 'DAO
                            newBar.Controls.Add Type:=msoControlButton, ID:=10094  'FilterLargerThanSelection
                        Case 1 'ADO
                            Set newItem = newBar.Controls.Add(msoControlButton)
                            newItem.Caption = "Filter >= Selection"
                            newItem.OnAction = "=adoNumFilter(2)"
                            newItem.Style = msoButtonCaption
                    End Select
                    
            End Select
        End If
            
            Set newItem = Nothing
            Set newBar = Nothing
            
        Next barType
    
    Next DSType
errctrl:


    Select Case err
        Case 3270 'not found
            Resume Next
        Case Else
            Resume Next
    End Select
    
End Function

[davegri]

You can also create context menus with macros. I don't know if this will work with the runtime.

A Macro For VBA Diehards - Creating Shortcut Popup Menus

[jojowhite]

maybe add a CommandButton on your form to perform Sort/Filter.
then add code to that button:

Private Sub TheFilterButton_Click()
    Dim ctl As Control
    On Error Resume Next
    Set ctl = Screen.PreviousControl
    If Err Then
        Exit Sub
    End If
    If TypeOf ctl Is TextBox Then
        ctl.SetFocus
        DoCmd.RunCommand acCmdFilterMenu
    End If
End Sub