' *******************************************
' MenuHelper.bas
Option Explicit

Private Type MENUITEMINFO
    cbSize          As Long     ' UINT
    fMask           As eMIIM    ' UINT
    fType           As eMF      ' UINT
    fState          As Long     ' UINT
    wid             As Long     ' UINT
    hSubMenu        As Long     ' HMENU
    hbmpChecked     As Long     ' HBITMAP
    hbmpUnchecked   As Long     ' HBITMAP
    dwItemData      As Long     ' ULONG_PTR
    dwTypeData      As String   ' LPTSTR
    cch             As Long     ' UINT
End Type

Private Enum eMIIM
    MIIM_ID = &H2&          ' Retrieves or sets the wID member.
    MIIM_SUBMENU = &H4&     ' Retrieves or sets the hSubMenu member.
    MIIM_STRING = &H40&     ' Retrieves or sets the dwTypeData member.
    MIIM_FTYPE = &H100&     ' Retrieves or sets the fType member.
End Enum

Private Enum eMF
    MF_SEPARATOR = &H800&
End Enum

Private Declare Function GetMenu Lib "User32.dll" (ByVal hWnd As Long) As Long
Private Declare Function GetMenuItemCount Lib "User32.dll" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuItemInfo Lib "User32.dll" Alias "GetMenuItemInfoA" ( _
    ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpmii As MENUITEMINFO) As Long


' -------------------------------------------------------
Public Sub GetMenusInfo(ByRef ownerForm As VB.Form, ByRef dicCaptions As Object _
    , ByRef dicKeys As Object)
    Set dicCaptions = CreateObject("Scripting.Dictionary")
    Set dicKeys = CreateObject("Scripting.Dictionary")
    
    Dim hMenubar As Long: hMenubar = GetMenu(ownerForm.hWnd) ' grab the form's menubar handle
    If hMenubar <> 0 Then
        Call EnumerateMenus(dicCaptions, dicKeys, "0", hMenubar, 0, ownerForm)
    End If
End Sub

' -------------------------------------------------------
Private Sub EnumerateMenus(ByVal dicCaptions As Object, ByVal dicKeys As Object _
    , ByVal sParentMenuKey As String, ByVal hMenu As Long, ByVal nLevel As Long _
    , ByVal ownerForm As VB.Form)

    If hMenu = 0 Then Exit Sub
    
    Dim nChildCount As Long: nChildCount = GetMenuItemCount(hMenu) ' return -1 if failed
    If nChildCount < 1 Then Exit Sub
    
    Dim nStartIndex As Long: nStartIndex = 0
    If Not ownerForm Is Nothing Then
        ' here hMenu is the main menu bar (first call)
        nStartIndex = IIf(ownerForm.WindowState = vbMaximized, 1, 0)
    End If
    
    Const CAP_LEN As Long = 127
    Dim mii As MENUITEMINFO
    mii.cbSize = Len(mii)
    mii.fMask = MIIM_ID Or MIIM_FTYPE Or MIIM_STRING Or MIIM_SUBMENU
    
    Dim sCaption As String, n As Long, sTemp() As String, sMenuKey
    
    Dim i As Long: For i = nStartIndex To (nChildCount - 1)
        mii.fType = 0
        mii.wid = 0
        mii.dwTypeData = String$(CAP_LEN + 1, 0)
        mii.cch = CAP_LEN
        
        Call GetMenuItemInfo(hMenu, i, True, mii)
        
        If mii.fType <> MF_SEPARATOR Then
            sCaption = Left$(mii.dwTypeData, mii.cch) ' includes accelerator, if any
            
            If Len(sCaption) > 0 Then
                sTemp = Split(sCaption, vbTab, 2)
                sCaption = Trim(sTemp(0)) ' get rid of the accelerator (if any)
                
                sMenuKey = Hex8(hMenu) & ":" & Hex8(mii.wid)
                dicCaptions(sMenuKey) = sCaption
                dicKeys(sCaption) = Array(sMenuKey, sParentMenuKey)
            End If
            
            Call EnumerateMenus(dicCaptions, dicKeys, sMenuKey _
                , mii.hSubMenu, nLevel + 1, Nothing) ' mii.hSubMenu can be null (0)
        End If
    Next

End Sub

' -------------------------------------------------------
Private Function Hex8(n As Long) As String: Hex8 = Right("0000000" & Hex(n), 8): End Function



' *******************************************
' MainForm.frm

' -------------------------------------------------------
Private Sub EnumMenus()
    Dim dicCaptions As Object, dicKeys As Object
    Dim sKeys As Variant, sMenuKey As String, sParentMenuKey As String, s As String
    
    Call MenuHelper.GetMenusInfo(Me, dicCaptions, dicKeys)
    
    Dim c As VB.Control: For Each c In Me.Controls
        If TypeOf c Is VB.Menu Then
            ' BUG: if 2 menus/sub-menus have the same caption, only the first one is returned
            sKeys = dicKeys(c.Caption)
            sMenuKey = sKeys(0): sParentMenuKey = sKeys(1)
            
            s = sMenuKey & vbTab & c.Name
            If sParentMenuKey = "0" Then
                s = s & " has no parent"  ' main menu
            Else
                s = s & "'s parent is " & sParentMenuKey & ":'" _
                    & dicCaptions(sParentMenuKey) & "'" ' sub-menu
            End If
            Debug.Print s
        End If
    Next
End Sub

sMenuKey = Hex8(hMenu) & ":" & Hex8(mii.wid)

If Len(sCaption) > 0 Then