动态添加菜单问题请教

我的动态添加菜单的代码如下，请问如何修改：（现在运行的结果是所有的三级菜单都一样子了）Option Explicit
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rss As New ADODB.RecordsetPrivate Sub Form_Load()
    Set rs = New ADODB.Recordset
    conn.Open "DBQ=" & App.Path & "\mnuDate.mdb" & ";Driver={Microsoft Access Driver (*.mdb)};pwd="
    rs.Open ("select DISTINCT 父用户组 from 表1"), conn, 1, 3
    Dim smnu As String '//父用户组菜单项
    hMenu = CreateMenu()
    hmenupopup = CreatePopupMenu()
    hmenupopup1 = CreatePopupMenu()
    hmenupopup2 = CreatePopupMenu()
    result = AppendMenu(hMenu, MF_POPUP, hmenupopup, "&File")
    result = AppendMenu(hmenupopup, MF_STRING, 300, "&Save")
    result = AppendMenu(hmenupopup, MF_STRING, 200, "&SaveAs")
    result = AppendMenu(hmenupopup, MF_POPUP, hmenupopup1, "&New")
    '//添加父用户组
    While Not rs.EOF
        smnu = rs("父用户组")
        result = AppendMenu(hmenupopup1, MF_POPUP, hmenupopup2, smnu)
        Call xmnus(smnu)
        rs.MoveNext
    Wend
    rs.Close
    
    oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf OnMenu
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim r As RECT
    Dim p As POINTAPI
    If Button = vbRightButton Then
        GetCursorPos p
        TrackPopupMenu hmenupopup, 0, p.x, p.y, 0, Me.hWnd, r
    End If
End SubPrivate Sub Form_Unload(Cancel As Integer)
    SetWindowLong Me.hWnd, GWL_WNDPROC, oldwinproc
End SubPrivate Function xmnus(smnu As String)   '//添加子用户组
    Set rss = New ADODB.Recordset
    Dim xmnu As String '//子用户组菜单项
    rss.Open ("select DISTINCT 子用户组 from 表1 where 父用户组='" & smnu & "'"), conn, 1, 3
    While Not rss.EOF
        xmnu = rss("子用户组")
        result = AppendMenu(hmenupopup2, MF_STRING, 500, xmnu)
        rss.MoveNext
    Wend
    rss.Close
End Function