ms-access - 通过 vba Access 更改导航 Pane 组

Question

我有一个 VBA 代码模块在 Access 中创建 4 个新表并将它们添加到数据库中。我想在最后添加一个部分，通过自定义组在导航 Pane 中组织它们，以便它们都被组织起来。这可以通过vba实现吗？

编辑:

我不希望这些表位于未分配的对象组中。我想通过 VBA 更改该组的名称。

Answer 1

非常感谢您的代码，
由于表格刷新的问题，我不得不根据我的具体情况对其进行一些修改。
事实上，我正在重新创建一个表(之前删除旧表)。由于 MSysNavPaneObjectIDs 不刷新，旧 ID 保留在里面。

例如让我们使用一个表 tmpFoo，我想把它放在一个组 TEMP 中。

tmpFoo 已经在组 TEMP 中。 TEMP 的 ID 为 1，tmpFoo 的 ID 为 1000
然后我删除 tmpFoo，并立即重新创建 tmpFoo。
tmpFoo 现在位于“未分配对象”中。

在 MSysObjects 中，tmpFoo 的 ID 现在是 1100，但是在 MSysNavPaneObjectIDs 中，表格没有刷新，这里的 tmpFoo 的 ID 仍然是 1000。

在这种情况下，在表 MSysNavPaneGroupToObjects 中创建了 TEMP(1) 和 tmpFoo(1000) 之间的链接 => 没有发生任何事情，因为 ID 1000 在 MSysObjects 中不再存在。

因此，以下修改后的代码在所有情况下都从 MSysObjects 获取 ID，然后检查该 ID 是否存在于 MSysNavPaneObjectIDs 中。

如果没有，请添加该行，然后使用相同的 ID 将其添加到 MSysNavPaneGroupToObjects。

这样看来我没有任何刷新问题(在上层函数中添加 Application.RefreshDatabaseWindow)。
再次感谢韦恩，

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