Adding linked table object to MSysNavPaneGroupToObjects via VBA not working as expected

Dick Watson 81 Reputation points
2022-04-21T23:15:41.513+00:00

Env: Office365 Home on Windows 10 Pro x64. All current in regular release channels.

I have some VBA to update .Connect strings for a set of linked tables. It breaks the previously UI-assigned NavPaneGroupToobjects entry for these objects since RefreshLink changes their ID in MSysNavPaneObjectIDs. So I wrote code to insert the new ObjectID and the GroupID for my custom group into MSysNavPaneGroupToObjects, deriving from examples I Googled. The code includes a RefreshDatabaseWindow call. I've inspected entries in MSysNavPaneGroupToObjects after running my code, and after using the UI to add the objects to the group, and they look the same. But they don't display in the group when I add them via VBA, but do when added via the UI.

Function SetNavPaneGroup(strObjName As String, strGroupName As String, Optional strRenameShortcut As String = "", Optional db As DAO.Database)
'
' derived from https://stackoverflow.com/questions/12863959/access-custom-group
'
' someday we should add in some return here...
'

    If db Is Nothing Then Set db = CurrentDb()

    Dim rs As DAO.Recordset, lngIdObj As Long, lngIdGrp As Long, lngMaxPos As Long

    ' find the ObjectID
    Set rs = db.OpenRecordset("SELECT Id from MSysNavPaneObjectIDs WHERE (Name=""" & strObjName & """);", dbOpenSnapshot)

    ' proceed if we found one
    If Not rs.EOF Then
        lngIdObj = rs!id

        ' find the NavPaneGroupId
        Set rs = db.OpenRecordset("SELECT Id from MSysNavPaneGroups WHERE (Name=""" & strGroupName & """);", dbOpenSnapshot)

        ' proceed if we found one
        If Not rs.EOF Then

            lngIdGrp = rs!id

            ' get the current max Position in this Nav Group
            Set rs = db.OpenRecordset("SELECT Max(MSysNavPaneGroupToObjects.Position) AS MaxOfPosition " & _
                                      "FROM MSysNavPaneGroupToObjects " & _
                                      "WHERE (MSysNavPaneGroupToObjects.GroupID=" & lngIdGrp & ");", dbOpenSnapshot)
            If IsNull(rs!MaxOfPosition) Then lngMaxPos = -1 Else lngMaxPos = rs!MaxOfPosition

            ' get a current NavPaneGroup association
            Set rs = db.OpenRecordset("SELECT GroupID, Name FROM MSysNavPaneGroupToObjects WHERE (GroupID = " & lngIdGrp & " AND ObjectID = " & lngIdObj & ");", dbOpenDynaset)

            If Not rs.EOF Then
                If "" <> strRenameShortcut Then
                    rs.Edit
                    rs!Name = strRenameShortcut
                    rs.Update
                End If
            Else
                db.Execute "INSERT INTO MSysNavPaneGroupToObjects ( Flags, GroupID, Icon, Name, ObjectID, Position ) " & vbCrLf & _
                           "VALUES (0," & lngIdGrp & ", 0, """ & IIf("" = strRenameShortcut, strObjName, strRenameShortcut) & """, " & lngIdObj & ", " & lngMaxPos + 1 & ");", dbFailOnError
            End If

            RefreshDatabaseWindow

        End If

    End If

    Set rs = Nothing

End Function

Is there some other magic, am I broken, or is this path to programmatic control of custom group membership just broken?

Access Development
Access Development
Access: A family of Microsoft relational database management systems designed for ease of use.Development: The process of researching, productizing, and refining new or existing technologies.
818 questions
0 comments No comments
{count} votes