An Excel VBA module snippet that allows macro menu import/export

menu.bas

' menu.bas - An Excel VBA module snippet that allows macro menu import/export
' Copyright 2012 (C) ooharak. All Rights Reserved.
' Note that currently you have to add a reference to MS Forms 2.0 type library
'
Option Explicit 
Sub OpenBookLocation()
    Call Shell("explorer """ & ActiveWorkbook.Path & """", vbNormalFocus)
End Sub

Private Function InitReferences() As Variant
On Error GoTo catch
    Dim ref As Variant
    ref = ThisWorkbook.VBProject.References.AddFromGuid("{835AC3CE-E36B-4D65-B50F-2863A682ABEE}", 2, 0)
    Set InitReferences = ref
    
catch:
    If Err.Number = 32813 Then
        Resume Next
    End If
    Error Err.Number
End Function

Sub CopyMenuBarInfoToClipboard()
    Dim mbar As CommandBar
    Dim s As String
    
    s = ""
    Set mbar = CommandBars("Worksheet Menu Bar")
    Dim macro As CommandBarPopup
    Set macro = mbar.Controls("(&M)acro")
    Dim subm As CommandBarControl
    
    Dim level As Integer
    level = 1
    For Each subm In macro.Controls
        s = s & searchMenuBar(0, subm)
    Next subm
    
    Dim cb As New DataObject
    cb.setText s
    cb.PutInClipboard
End Sub

Private Function searchMenuBar(ByVal level As Integer, ByRef ctl As CommandBarControl) As String
    Dim s As String
    Dim popup As CommandBarPopup
    Dim subm As CommandBarControl
    
    If level > 7 Then
        searchMenuBar = "STK"
        Exit Function
    End If
    
    s = ""
    Select Case ctl.Type
        Case msoControlPopup
            s = s & "P" & level & ctl.caption & Chr(&HD) & Chr(&HA)
            Set popup = ctl
            For Each subm In popup.Controls
                s = s & searchMenuBar(level + 1, subm)
            Next subm
        Case Else
'                s = s & "M" & level & ctl.caption & Chr(9) & IIf(ctl.BuiltIn, "ID=" & ctl.id, ctl.OnAction) & Chr(&HD) & Chr(&HA)
            If ctl.BuiltIn Then
                s = s & "M" & level & ctl.caption & Chr(9) & "ID=" & ctl.id & Chr(&HD) & Chr(&HA)
            Else
                s = s & "M" & level & ctl.caption & Chr(9) & ctl.OnAction & Chr(&HD) & Chr(&HA)
            End If
    End Select
    searchMenuBar = s
End Function

Sub LoadMenuBarInfo()
    Dim mbar As CommandBar
    Dim s As String
    s = ""
    
    Set mbar = CommandBars("Worksheet Menu Bar")
    Dim macro As CommandBarPopup
    Set macro = mbar.Controls.Add(msoControlPopup)
    macro.caption = "DD(&M)acro"
    macro.Visible = True
    
    Dim fname As String
    fname = "c:\xlmenu.txt"
    
    Dim fd As Integer
    fd = FreeFile
    
    Open fname For Input As fd
    
    On Error GoTo finally
    
    Dim line As String
    Dim mode As String
    Dim level As String
    Dim caption As String
    Dim param As String
    Dim id As Integer
    Dim curm As CommandBarControl
    Dim curp As CommandBarPopup
    Dim curlevel As Integer
    curlevel = -1
    Set curm = macro
    Dim modeVar As Variant
    
    Do While Not EOF(fd)
        Line Input #fd, line
        mode = Left(line, 1)
        level = CInt(Mid(line, 2, 1))
        caption = Mid(line, 3)
        
        If mode = "P" Then
            modeVar = msoControlPopup
            param = ""
        Else
            modeVar = msoControlButton
            
            Dim ary() As String
            ary = Split(caption, Chr(9))
            caption = ary(0)
            param = ary(1)
        End If
        
        If level > curlevel Then
            Set curp = curm
            Set curm = addControl(curm, modeVar, param)
            curlevel = level
            curm.caption = caption
        Else ' level < curlevel
            'TODO: Investigate why Parent.Parent.Parent, not Parent.Parent
            'TODO: two or more levels of leap
            Set curm = addControl(curm.Parent.Parent.Parent, modeVar, param)
            curlevel = level
            curm.caption = caption
        End If
    Loop
    
finally:
    Close fd

End Sub

Private Function addControl(ByRef menu As Variant, ByRef mode As Variant, ByRef param As String) As CommandBarControl
    Dim id As Integer
    If Left(param, 3) = "ID=" Then
        id = CInt(Mid(param, 4))
        Set addControl = menu.Controls.Add(Type:=mode, id:=id)
    Else
        Set addControl = menu.Controls.Add(mode)
        If (param <> "") Then
            addControl.OnAction = param
        End If
    End If
End Function