EDIT: Added more code to add other object types to the custom Nav group.
The following code will assign tables to your custom Navigation Group.
WARNING!! There is a 'refresh' issue of table 'MSysNavPaneObjectIDs' that I am still trying to resolve. If you create a new table and then try to add to your group - sometimes it works on the first try, other times it fails but will work after a delay [sometimes up to five or ten minutes!]
At this moment, I got around the issue [when it fails] by reading info from table 'MSysObjects', then adding a new record to 'MSysNavPaneObjectIDs'.
The code below simply creates five small tables and adds to Nav Group 'Clients'
Modify the code to use your Group name / table names.
Option Compare Database
Option Explicit
Sub Test_My_Code[]
Dim dbs As DAO.Database
Dim strResult As String
Dim i As Integer
Dim strSQL As String
Dim strTableName As String
Set dbs = CurrentDb
For i = 1 To 5
strTableName = "Query" & i
'>>> CHANGE FOLLOWING LINE TO YOUR CUSTOM NAME
' Pass the Nav Group, Object Name, Object Type
strResult = SetNavGroup["Clients", strTableName, "Query"]
Debug.Print strResult
Next i
For i = 1 To 5
strTableName = "0000" & i
strSQL = "CREATE TABLE " & strTableName & " [PayEmpID INT, PayDate Date];"
dbs.Execute strSQL
'>>> CHANGE FOLLOWING LINE TO YOUR CUSTOM NAME
' Pass the Nav Group, Object Name, Object Type
strResult = SetNavGroup["Clients", strTableName, "Table"]
Debug.Print strResult
Next i
dbs.Close
Set dbs = Nothing
End Sub
Function SetNavGroup[strGroup As String, strTable As String, strType As String] As String
Dim strSQL As String
Dim dbs As DAO.Database
Dim rs As DAO.recordSet
Dim lCatID As Long
Dim lGrpID As Long
Dim lObjID As Long
Dim lType As Long
SetNavGroup = "Failed"
Set dbs = CurrentDb
' Ignore the following code unless you want to manage 'Categories'
' Table MSysNavPaneGroupCategories has fields: Filter, Flags, Id [AutoNumber], Name, Position, SelectedObjectID, Type
' strSQL = "SELECT Id, Name, Position, Type " & _
' "FROM MSysNavPaneGroupCategories " & _
' "WHERE [[[MSysNavPaneGroupCategories.Name]='" & strGroup & "']];"
' Set rs = dbs.OpenRecordset[strSQL]
' If rs.EOF Then
' MsgBox "No group named '" & strGroup & "' found. Will quit now.", vbOKOnly, "No Group Found"
' rs.Close
' Set rs = Nothing
' dbs.Close
' Set dbs = Nothing
' Exit Function
' End If
' lCatID = rs!ID
' rs.Close
' When you create a new table, it's name is added to table 'MSysNavPaneObjectIDs'
' Types
' Type TypeDesc
'-32768 Form
'-32766 Macro
'-32764 Reports
'-32761 Module
'-32758 Users
'-32757 Database Document
'-32756 Data Access Pages
'1 Table - Local Access Tables
'2 Access object - Database
'3 Access object - Containers
'4 Table - Linked ODBC Tables
'5 Queries
'6 Table - Linked Access Tables
'8 SubDataSheets
If LCase[strType] = "table" Then
lType = 1
ElseIf LCase[strType] = "query" Then
lType = 5
ElseIf LCase[strType] = "form" Then
lType = -32768
ElseIf LCase[strType] = "report" Then
lType = -32764
ElseIf LCase[strType] = "module" Then
lType = -32761
ElseIf LCase[strType] = "macro" Then
lType = -32766
Else
MsgBox "Add your own code to handle the object type of '" & strType & "'", vbOKOnly, "Add Code"
dbs.Close
Set dbs = Nothing
Exit Function
End If
' Table MSysNavPaneGroups has fields: Flags, GroupCategoryID, Id, Name, Object, Type, Group, ObjectID, Position
Debug.Print "---------------------------------------"
Debug.Print "Add '" & strType & "' " & strTable & "' to Group '" & strGroup & "'"
strSQL = "SELECT GroupCategoryID, Id, Name " & _
"FROM MSysNavPaneGroups " & _
"WHERE [[[MSysNavPaneGroups.Name]='" & strGroup & "'] AND [[MSysNavPaneGroups.Name] Not Like 'Unassigned*']];"
Set rs = dbs.OpenRecordset[strSQL]
If rs.EOF Then
MsgBox "No group named '" & strGroup & "' found. Will quit now.", vbOKOnly, "No Group Found"
rs.Close
Set rs = Nothing
dbs.Close
Set dbs = Nothing
Exit Function
End If
Debug.Print rs!GroupCategoryID & vbTab & rs!ID & vbTab & rs!Name
lGrpID = rs!ID
rs.Close
Try_Again:
' Filter By Type
strSQL = "SELECT Id, Name, Type " & _
"FROM MSysNavPaneObjectIDs " & _
"WHERE [[[MSysNavPaneObjectIDs.Name]='" & strTable & "'] AND [[MSysNavPaneObjectIDs.Type]=" & lType & "]];"
Set rs = dbs.OpenRecordset[strSQL]
If rs.EOF Then
' Seems to be a refresh issue / delay! I have found no way to force a refresh.
' This table gets rebuilt at the whim of Access, so let's try a different approach....
' Lets add the record vis code.
Debug.Print "Table not found in MSysNavPaneObjectIDs, try MSysObjects."
strSQL = "SELECT * " & _
"FROM MSysObjects " & _
"WHERE [[[MSysObjects.Name]='" & strTable & "'] AND [[MSysObjects.Type]=" & lType & "]];"
Set rs = dbs.OpenRecordset[strSQL]
If rs.EOF Then
MsgBox "This is crazy! Table '" & strTable & "' not found in MSysObjects.", vbOKOnly, "No Table Found"
rs.Close
Set rs = Nothing
dbs.Close
Set dbs = Nothing
Exit Function
Else
Debug.Print "Table not found in MSysNavPaneObjectIDs, but was found in MSysObjects. Lets try to add via code."
strSQL = "INSERT INTO MSysNavPaneObjectIDs [ ID, Name, Type ] VALUES [ " & rs!ID & ", '" & strTable & "', " & lType & "]"
dbs.Execute strSQL
GoTo Try_Again
End If
End If
Debug.Print rs!ID & vbTab & rs!Name & vbTab & rs!type
lObjID = rs!ID
rs.Close
' Add the table to the Custom group
strSQL = "INSERT INTO MSysNavPaneGroupToObjects [ GroupID, ObjectID, Name ] VALUES [ " & lGrpID & ", " & lObjID & ", '" & strTable & "' ]"
dbs.Execute strSQL
dbs.Close
Set dbs = Nothing
SetNavGroup = "Passed"
End Function
How do you change the navigation pane grouping in Access?
With a custom category and group open in the Navigation Pane, right-click an object that you want to place in a new group. Point to Add to group, and then click New Group. A new group appears in the Navigation Pane. Enter a name for the new group, and then press ENTER.
How do you group the objects in the navigation pane by tables and related views?
Answer: To view the tables and related objects in the Navigation Pane, click on the Navigation Pane menu and select "Tables and Related Views" from the popup menu. Now the Navigation Pane should group by table and display each object related to that table.
How do I change the navigation pane?
To edit the navigation pane in Windows 11/10, press the Windows key + E hotkey to open Windows Explorer. Click the View tab. Click the Navigation pane button in the ribbon. In the drop-down menu, you can click to check or uncheck the “Navigation pane” option.