Listing a menu structure

[Scrantic007]

Hi Guys,

I am urgently looking for some assistance listing a menu structure.
I have a form with around 300 menu items, and it goes 4 levels deep. My requirements is to build a report to list all these menu items, and get the user permission for each.
I have so far went through the Form's controls, and getting all the relevant menu items, index's and captions. The problem is I cannot determine the parent/child relation between these items.
I have resorted to using the GetMenuItemInfo api calls, but this ONLY returns the caption(text) of each menu item. I have also used both these methods in conjunction, but this is not feasible, since we the menu structure for eg &File is using the same menuname (mnuFile) with an index to make it unique.
By using the form's control iteration, I can ALMOST get it done, but I desperately need the level (parent/child) relation of each.
Here is the code to find the menu's via the API
Public Sub IterateThroughItems(ByVal hMenu As Long, ByVal Level As Long)
' hMenu is a handle to the menu to output
' level is the level of recursion, used to indent submenu items
Dim itemcount As Long ' the number of items in the specified menu
Dim C As Long ' loop counter variable
Dim mii As MENUITEMINFO ' receives information about each item
Dim retval As Long ' return value
Dim iChr9 As Integer
Dim sCaption As String, sTemp() As String
Dim iState As Integer
Dim HasSubmenu As Boolean
Dim bAddMenu As Boolean


' Count the number of items in the menu passed to this subroutine.
itemcount = GetMenuItemCount(hMenu)

' Loop through the items, getting information about each one.
With mii
.cbSize = Len(mii)
.fMask = MIIM_STATE Or MIIM_TYPE Or MIIM_SUBMENU Or MIIM_DATA
For C = 0 To itemcount - 1
' Make room in the string buffer.
.dwTypeData = Space(256)
.cch = 256
' Get information about the item.
.cbSize = Len(mii)
.fMask = MIIM_STATE Or MIIM_TYPE Or MIIM_SUBMENU Or MIIM_DATA

retval = GetMenuItemInfo(hMenu, C, 1, mii)
' Output a line of information about this item.
If mii.fType = MFT_SEPARATOR Then
' This is a separator bar, skip
Else
' This is a text item.

'Exclude the Custom added menus for Companies...
If Left(Trim(.dwTypeData), 1) = "&" Then
If (IsNumeric(mId(Trim(.dwTypeData), 2, 1)) And mId(Trim(.dwTypeData), 3, 1) = " ") Then
bAddMenu = False
Else
bAddMenu = True
End If
End If

If bAddMenu Then
rsStructMenus.AddNew

iChr9 = InStr(1, .dwTypeData, Chr(9))
If iChr9 > 0 Then
rsStructMenus!MenuCaption = Trim(mId(.dwTypeData, 1, iChr9 - 1))
Else
rsStructMenus!MenuCaption = Trim(Left(.dwTypeData, .cch))
End If
rsStructMenus!MenuLevel = Level

'Determine MenuInfo from the Structure recordset
ReDim sTemp(3)
sTemp = Split(FindMenuInfo(rsStructMenus!MenuCaption), "~")
rsStructMenus!MenuName = sTemp(0)
rsStructMenus!MenuIndex = sTemp(1)
rsStructMenus!MenuIsVisible = sTemp(2)
rsStructMenus!MenuParent = FindParent(rsStructMenus!MenuCaption)
rsStructMenus!HasSubmenus = HasSubmenu
' If this item opens a submenu, display its contents.
If .hSubMenu <> 0 Then
HasSubmenu = True
IterateThroughItems .hSubMenu, Level + 1
Else
HasSubmenu = False
End If
End If
End If
Next C
End With

End Sub

I am building a recordset from the Form's menuItems
'Loop through form controls to get the menu items with names as well as captions
For MenuLoop = 0 To Main.Controls.count - 1
If TypeOf Main.Controls(MenuLoop) Is Menu Then
If Main.Controls(MenuLoop).Caption <> "-" And Main.Controls(MenuLoop).Enabled = True Then
If InStr(UCase(Main.Controls(MenuLoop).Name), "CASCADED") = 0 _
And InStr(UCase(Main.Controls(MenuLoop).Name), "MNUVIEWBIC") = 0 _
And InStr(UCase(Main.Controls(MenuLoop).Name), "HLP") = 0 _
And InStr(UCase(Main.Controls(MenuLoop).Name), "POP") = 0 _
And InStr(UCase(Main.Controls(MenuLoop).Name), "DOC") = 0 _
And InStr(UCase(Main.Controls(MenuLoop).Name), "MNUSTYLE") = 0 _
And InStr(UCase(Main.Controls(MenuLoop).Name), "MNUVIEWEXTREPORTS") = 0 _
And InStr(UCase(Main.Controls(MenuLoop).Name), "ARRANGE") = 0 Then
rsStructureMenus.AddNew
rsStructureMenus!MenuName = Main.Controls(MenuLoop).Name
rsStructureMenus!MenuIndex = Main.Controls(MenuLoop).Index
rsStructureMenus!MenuCaption = Trim(Main.Controls(MenuLoop).Caption)
rsStructureMenus!MenuVisible = Main.Controls(MenuLoop).Visible
End If
End If
End If
ReadNext:
Next MenuLoop

and then trying to find the relevant info in the last recordset to build the top recordset.
The problem is we have up to 5 possible duplicated menu captions in different topmenu structures...

Is there a way to get the menuname and index from the GetMenuItemInfo API call, or something else I can use. Nothing on google even remotely can help me...

[Joacim Andersson]

Question moved to it's own thread.

[techgnome]

Public Sub IterateThroughItems(ByVal hMenu As Long, ByVal Level As Long)
   ' hMenu is a handle to the menu to output
   ' level is the level of recursion, used to indent submenu items
   Dim itemcount As Long    ' the number of items in the specified menu
   Dim C As Long            ' loop counter variable
   Dim mii As MENUITEMINFO  ' receives information about each item
   Dim retval As Long       ' return value
   Dim iChr9 As Integer
   Dim sCaption As String, sTemp() As String
   Dim iState As Integer
   Dim HasSubmenu As Boolean
   Dim bAddMenu As Boolean

   
   ' Count the number of items in the menu passed to this subroutine.
   itemcount = GetMenuItemCount(hMenu)
   
   ' Loop through the items, getting information about each one.
   With mii
      .cbSize = Len(mii)
      .fMask = MIIM_STATE Or MIIM_TYPE Or MIIM_SUBMENU Or MIIM_DATA
      For C = 0 To itemcount - 1
         ' Make room in the string buffer.
         .dwTypeData = Space(256)
         .cch = 256
         ' Get information about the item.
      .cbSize = Len(mii)
      .fMask = MIIM_STATE Or MIIM_TYPE Or MIIM_SUBMENU Or MIIM_DATA
      
      retval = GetMenuItemInfo(hMenu, C, 1, mii)
      ' Output a line of information about this item.
      If mii.fType = MFT_SEPARATOR Then
         ' This is a separator bar, skip
      Else
         ' This is a text item.

            'Exclude the Custom added menus for Companies...
            If Left(Trim(.dwTypeData), 1) = "&" Then
               If (IsNumeric(mId(Trim(.dwTypeData), 2, 1)) And mId(Trim(.dwTypeData), 3, 1) = " ") Then
                  bAddMenu = False
               Else
                  bAddMenu = True
               End If
            End If
            
            If bAddMenu Then
               rsStructMenus.AddNew
   
               iChr9 = InStr(1, .dwTypeData, Chr(9))
               If iChr9 > 0 Then
                  rsStructMenus!MenuCaption = Trim(mId(.dwTypeData, 1, iChr9 - 1))
               Else
                  rsStructMenus!MenuCaption = Trim(Left(.dwTypeData, .cch))
               End If
               rsStructMenus!MenuLevel = Level
               
               'Determine MenuInfo from the Structure recordset
               ReDim sTemp(3)
               sTemp = Split(FindMenuInfo(rsStructMenus!MenuCaption), "~")
               rsStructMenus!MenuName = sTemp(0)
               rsStructMenus!MenuIndex = sTemp(1)
               rsStructMenus!MenuIsVisible = sTemp(2)
               rsStructMenus!MenuParent = FindParent(rsStructMenus!MenuCaption)
               rsStructMenus!HasSubmenus = HasSubmenu
               ' If this item opens a submenu, display its contents.
               If .hSubMenu <> 0 Then
                  HasSubmenu = True
                  IterateThroughItems .hSubMenu, Level + 1
               Else
                  HasSubmenu = False
               End If
            End If
         End If
      Next C
   End With
   
End Sub

I am building a recordset from the Form's menuItems
   'Loop through form controls to get the menu items with names as well as captions
   For MenuLoop = 0 To Main.Controls.count - 1
      If TypeOf Main.Controls(MenuLoop) Is Menu Then
         If Main.Controls(MenuLoop).Caption <> "-" And Main.Controls(MenuLoop).Enabled = True Then
            If InStr(UCase(Main.Controls(MenuLoop).Name), "CASCADED") = 0 _
               And InStr(UCase(Main.Controls(MenuLoop).Name), "MNUVIEWBIC") = 0 _
               And InStr(UCase(Main.Controls(MenuLoop).Name), "HLP") = 0 _
               And InStr(UCase(Main.Controls(MenuLoop).Name), "POP") = 0 _
               And InStr(UCase(Main.Controls(MenuLoop).Name), "DOC") = 0 _
               And InStr(UCase(Main.Controls(MenuLoop).Name), "MNUSTYLE") = 0 _
               And InStr(UCase(Main.Controls(MenuLoop).Name), "MNUVIEWEXTREPORTS") = 0 _
               And InStr(UCase(Main.Controls(MenuLoop).Name), "ARRANGE") = 0 Then
                  rsStructureMenus.AddNew
                  rsStructureMenus!MenuName = Main.Controls(MenuLoop).Name
                  rsStructureMenus!MenuIndex = Main.Controls(MenuLoop).Index
                  rsStructureMenus!MenuCaption = Trim(Main.Controls(MenuLoop).Caption)
                  rsStructureMenus!MenuVisible = Main.Controls(MenuLoop).Visible
            End If
         End If
      End If
ReadNext:
   Next MenuLoop

Next time you post code... especially a wall of code like that... put [code][/code] tags around it... you can see the difference between yours and mine when you do... it's much easier to read...

I have resorted to using the GetMenuItemInfo api calls, but this ONLY returns the caption(text) of each menu item. I have also used both these methods in conjunction, but this is not feasible, since we the menu structure for eg &File is using the same menuname (mnuFile) with an index to make it unique.
By using the form's control iteration, I can ALMOST get it done, but I desperately need the level (parent/child) relation of each.
Here is the code to find the menu's via the API

and then trying to find the relevant info in the last recordset to build the top recordset.
The problem is we have up to 5 possible duplicated menu captions in different topmenu structures...

Is there a way to get the menuname and index from the GetMenuItemInfo API call, or something else I can use. Nothing on google even remotely can help me...

I think you're going to have a hard time with that w/o source code... the name of the menu item it irrelevant once it is compiled. It doesn't care if it's called mnuFile or if it was called James. Once it is compiled, it's just a memory address location. An area on the UI canvas that has an hwnd, even the hierarchy is largely irrelevant as it simply gets painted on the screen at a particular location. Which is why the API is less than helpful... it's only able to work with what its got.

This "I have so far went through the Form's controls, and getting all the relevant menu items, index's and captions." ... insinuates that you DO have the source code... which means you should have that relationship... it maybe in the designer, but the information should be there. It might be buried... are these menu items created at runtime? or were they all setup at designtime? Or is it a mix?

-tg