Change Navigation pane group in access through vba

Question

I have a module of VBA code in access that creates 4 new tables and adds them to the database. I would like to add in a part at the end where they are organized in the navi

Answer 1

Thanks a lot for your code, I had to modify it a little on my specific case due to the issue on the refresh of the table. In fact I am recreating a table (deleting the old one before). As the MSysNavPaneObjectIDs does not refresh, the old ID is kept inside.

e.g. let's use a table tmpFoo that I want to put in a group TEMP.

tmpFoo is already in group TEMP. TEMP has ID 1 and tmpFoo has ID 1000 Then I delete tmpFoo, and immediately recreate tmpFoo. tmpFoo is now in 'Unassigned Objects'.

In MSysObjects, ID of tmpFoo is now 1100, but in MSysNavPaneObjectIDs the table is not refreshed and the ID of tmpFoo here is still 1000.

In this case, in the table MSysNavPaneGroupToObjects a link between TEMP(1) and tmpFoo(1000) is created => Nothing happen as ID 1000 does not exists anymore in MSysObjects.

So, the modified code below get in all cases ID from MSysObjects, then check if the ID exists in MSysNavPaneObjectIDs.

If not, add the line, then use the same ID to add it to MSysNavPaneGroupToObjects.

In this way seems I do not have any refresh issue (adding Application.RefreshDatabaseWindow in the upper function). Thanks again Wayne,

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

    ' 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

    ' Get Table ID From 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
    End If

    lObjID = rs!ID

    Debug.Print "Table found in MSysObjects " & lObjID & " . Lets compare to MSysNavPaneObjectIDs."

   ' Filter By Type
    strSQL = "SELECT Id, Name, Type " & _
            "FROM MSysNavPaneObjectIDs " & _
            "WHERE (((MSysNavPaneObjectIDs.ID)=" & lObjID & ") 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 via this code.
        Debug.Print "Table not found in MSysNavPaneObjectIDs, add it from MSysObjects."
        strSQL = "INSERT INTO MSysNavPaneObjectIDs ( ID, Name, Type ) VALUES ( " & lObjID & ", '" & strTable & "', " & lType & ")"
        dbs.Execute strSQL
    End If
    Debug.Print lObjID & vbTab & strTable & vbTab & lType
    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