Question

我将Access 2007数据库配置为使用导航窗格中的“自定义”组。我以一种有意义的方式对我的所有桌子进行了分组。但是，每当我更新链接表时，它都会丢失其分组。

我一直无法找到避免这种情况的方法。由于它似乎是不可避免的，我想简单地创建一个宏，将表以编程方式添加回正确的组。我还没有找到任何关于如何做到这一点的例子。有什么建议吗？

Answer 1

put_into_group(obj_name, group_name)通过在MSysNavPaneGroupToObjects中添加/更新记录将对象移动到指定的组。

Function DLookupArr(Expr, Domain, Criteria)
' https://stackoverflow.com/questions/5864160
    Dim arr
    Set rs = CurrentDb.OpenRecordset("SELECT " & Expr & " FROM " & Domain & " WHERE " & Criteria)
    If rs.EOF Then
        DLookupArr = Array()
        Exit Function
    End If
    rs.MoveFirst
    Do While Not rs.EOF
        If IsEmpty(arr) Then ReDim arr(0) Else ReDim Preserve arr(UBound(arr) + 1)
        arr(UBound(arr)) = rs(Expr)
        rs.MoveNext
    Loop
    DLookupArr = arr
End Function

Function in_arr(v, arr) As Boolean
    For Each i In arr
        If i = v Then
            in_arr = True
            Exit Function
        End If
    Next i
End Function

Function get_object_group_id(obj_id) As Long
    obj_group_ids = DLookupArr("GroupID", "MSysNavPaneGroupToObjects", "ObjectID=" & obj_id) ' All object's groups
    groups_ids = DLookupArr("Id", "MSysNavPaneGroups", "GroupCategoryID=3") ' All groups IDs
    For Each i In obj_group_ids
        If in_arr(i, groups_ids) Then 'if it's a user-defined group then move from it to `group_name`
            get_object_group_id = i
            Exit For
        End If
    Next i
End Function

Function put_into_group(obj_name, group_name) As Boolean
    obj_id = DLookup("Id", "MSysObjects", "Name='" & obj_name & "'") ' Object-to-move ID
    If IsNull(obj_id) Then Exit Function
    obj_group_id = get_object_group_id(obj_id)
    group_id = DLookup("Id", "MSysNavPaneGroups", "Name='" & group_name & "' And GroupCategoryID=3") ' Target group ID
    If IsNull(group_id) Then Exit Function
    If obj_group_id = group_id Then ' already in group `group_name`
        put_into_group = True
        Exit Function
    End If
    If obj_group_id <> 0 Then ' if it's a user-defined group then move from it to `group_name`
        sql_s = "UPDATE MSysNavPaneGroupToObjects SET GroupID = " & group_id & _
                " WHERE ObjectID=" & obj_id & " And GroupID=" & obj_group_id
    Else ' if object was not in any user-defined groups then add new entry
        sql_s = "INSERT INTO MSysNavPaneGroupToObjects (GroupID, ObjectID, Name) " & _
                "VALUES (" & group_id & "," & obj_id & ",'" & obj_name & "')"
    End If
    CurrentDb.Execute sql_s, dbFailOnError
    RefreshDatabaseWindow
    put_into_group = True
End Function

Answer 2

您应该可以通过编辑系统表MSysNavPaneGroupToObjects来完成此操作。您将需要MSysNavPaneObjectIDs中的表ID和MSysNavPaneGroups中的组ID（右键单击导航窗格以访问“导航选项”并选中“显示系统对象”。然后您可以使用如下所示的查询来更改表的组。

UPDATE MSysNavPaneGroupToObjects SET GroupID = 9 WHERE ObjectID = 268

因为您使用系统文件，所以在启动之前备份.accdb文件。

Answer 3

类似的问题虽然mjoshawa的建议对我来说不太有用，但我通过在MsSystemNavPaneGroupToObjects表中插入一个新行来实现它。

INSERT INTO MSysNavPaneGroupToObjects ( GroupID, ObjectID, Name )
VALUES ( 55, 418, 'TableName' )

这是在创建表格后立即作为UI宏的一部分。

Answer 4

旧线程，我知道，但我只需处理这个问题，并且认为我会分享我的解决方案：将对象移动到一个组的函数。

Public Function SetNavPaneGroup(strObjName, strGroupName)
    Dim strSql, idObj, idGrp, db
    Set db = CurrentDb
    idObj = DLookup("Id", "MSysNavPaneObjectIDs", "Name='" & strObjName & "'")
    idGrp = DLookup("Id", "MSysNavPaneGroups", "Name='" & strGroupName & "'")

    If DCount("*", "MSysNavPaneGroupToObjects", "GroupID = " & idGrp & " AND ObjectID = " & idObj) > 0 Then
        strSql = "UPDATE MSysNavPaneGroupToObjects SET GroupID = " & idGrp & ", Name='" & strObjName & "' WHERE ObjectID = " & idObj
        db.Execute strSql, dbFailOnError
    Else
        strSql = "INSERT INTO MSysNavPaneGroupToObjects ( GroupID, ObjectID, Name ) " & vbCrLf & _
        "VALUES (" & idGrp & "," & idObj & ",'" & strObjName & "');"
        db.Execute strSql, dbFailOnError
    End If
    RefreshDatabaseWindow
    Set db = Nothing
End Function

享受。

访问自定义组

4 个答案: