Visual Basic - Menus Dinamicos

Tengo el siguiente codigo de menus dinamicos:

Dim inMenu As Integer, inmenu1 As Integer
Dim acceso As String, niv As String
'inMenu = 0
'inmenu1 = 0
Set rs = New ADODB.Recordset
sql = "select tDescripcionAcceso from tseguridadacceso where tTipoAcceso='M1' and tModulo='01'"
rs.Open sql, cn, adOpenKeyset, adLockOptimistic
While Not rs.EOF
If inMenu > 0 Then
Load mnuprueba(inMenu)
End If
mnuprueba(inMenu).Caption = Trim(rs!tdescripcionacceso)
inMenu = inMenu + 1
rs.MoveNext
Wend
Set rs = Nothing
Set rs = New ADODB.Recordset
sql = "select diSTINCT tNivel1 from tseguridadacceso where tmodulo='01'"
rs.Open sql, cn, adOpenKeyset, adLockOptimistic
While Not rs.EOF
niv = Trim(rs!tNivel1)
Set rs1 = New ADODB.Recordset
sql1 = "select tDescripcionAcceso from tseguridadacceso where tnivel1=tnivel2 and tnivel2='" & niv & "'"
rs1.Open sql1, cn, adOpenKeyset, adLockOptimistic
While Not rs1.EOF
If inmenu1 > 0 Then
Load mnusubprueba(inmenu1)
End If
mnusubprueba(inmenu1).Caption = Trim(rs1!tdescripcionacceso)
inmenu1 = inmenu1 + 1
rs1.MoveNext
Wend
'inmenu1 = ""
rs.MoveNext
Wend
Set rs = Nothing
Set rs1 = Nothing

el problema es en el submenu que me muestra todo el listado de primer menu al momento de ejecutar me muestra:

Archivo Doc
Guardar
Salir
Nuevo Doc

que deberia salir de esta manera

Archivo Doc
Guardar Nuevo Doc
Salir

haber si pudiera encontrar una solucion

gracias