Check if CommandBarPopup exists

[gabethegrape]

Hello,
I need some help inserting menu items for two addins (the attachment has the code for both addins in two separate modules). With each addin, I'm trying to add a sub menu to "My Menu". I can successfully do this if the first addin is activated first, but it gives me an error if the second addin is activated first because "My Menu" does not exist. How can I check if "My Menu" exists and if it does not, create it?

Thanks for your help!
Gabe

First Addin


Private Sub Workbook_Activate()

Run "addMenu"

End Sub

Private Sub Workbook_Deactivate()

Run "removeMenu"

End Sub

Sub addMenu()
Dim cmdbar As CommandBar
Dim toolsMenu As CommandBarControl
Dim myMenu As CommandBarPopup
Dim subMenu As CommandBarControl

' Point to the Worksheet Menu Bar
Set cmdbar = Application.CommandBars("Worksheet Menu Bar")

' Point to the Tools menu on the menu bar
Set toolsMenu = cmdbar.Controls("Tools")

' Create My Menu
Set myMenu = toolsMenu.Controls.Add(Type:=msoControlPopup)

' Create the sub Menu(s)
Set subMenu = myMenu.Controls.Add

With myMenu
.Caption = "My Menu"
.BeginGroup = False
With subMenu
.Caption = "sub Menu"
.BeginGroup = False
.OnAction = "'" & ThisWorkbook.Name & "'!myMacro" ' Assign Macro to Menu Item
End With
End With

End Sub
Private Sub myMacro()
MsgBox ("My Sub Menu Command")
End Sub

' How to remove the menu item
Sub removeMenu()

On Error Resume Next
Dim cmdbar As CommandBar
Dim CmdBarMenu As CommandBarControl
Set cmdbar = Application.CommandBars("Worksheet Menu Bar")
Set CmdBarMenu = cmdbar.Controls("Tools")
CmdBarMenu.Controls("My Menu").Delete
End Sub


Second Addin


Private Sub Workbook_Activate()

Run "addMenu"

End Sub

Private Sub Workbook_Deactivate()

Run "removeMenu"

End Sub

Sub addMenu()
Dim cmdbar As CommandBar
Dim toolsMenu As CommandBarControl
Dim myMenu As CommandBarPopup
Dim subMenu As CommandBarControl

' Point to the Worksheet Menu Bar
Set cmdbar = Application.CommandBars("Worksheet Menu Bar")

' Point to the Tools menu on the menu bar
Set toolsMenu = cmdbar.Controls("Tools")

Set myMenu = toolsMenu.Controls("My Menu")
If myMenu.Caption <> "My Menu" Then

Set myMenu = toolsMenu.Controls.Add(Type:=msoControlPopup)
With myMenu
.Caption = "My Menu"
.BeginGroup = False
End With
Else
' Point to the My Menu on in the Tools menu
Set myMenu = toolsMenu.Controls("My Menu")

' Create the sub Menu(s)
Set subMenu = myMenu.Controls.Add

With subMenu
.Caption = "sub Menu"
.BeginGroup = False
.OnAction = "'" & ThisWorkbook.Name & "'!myMacro" ' Assign Macro to Menu Item
End With
End If
End Sub
Private Sub myMacro()
MsgBox ("My Sub Menu Command")
End Sub

' How to remove the menu item
Sub removeMenu()

On Error Resume Next
Dim cmdbar As CommandBar
Dim CmdBarMenu As CommandBarControl
Set cmdbar = Application.CommandBars("Worksheet Menu Bar")
Set CmdBarMenu = cmdbar.Controls("Tools")
CmdBarMenu.Controls("My Menu").Delete
End Sub

Sub DeleteMenu()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&MyMenu").Delete
On Error GoTo 0
End Sub

[rbrhodes]

Hey BC!!

Dusty Rhodes here (Nanaimo, BC).

Re your code: I think you just have to trap the error, by which I mean you allow it and then check for it. Attempting to access a non-existant menu item will generate an error which you can then test for:


Sub addMenu()
Dim cmdbar As CommandBar
Dim myMenu As CommandBarPopup
Dim subMenu As CommandBarControl
Dim toolsMenu As CommandBarControl

' Point to the Worksheet Menu Bar
Set cmdbar = Application.CommandBars("Worksheet Menu Bar")

' Point to the Tools menu on the menu bar
Set toolsMenu = cmdbar.Controls("Tools")

'Allow error
On Error Resume Next

'Attempt to access myMenu - failure will generate an erro
Set myMenu = toolsMenu.Controls("My Menu")

'Trap the error
If Err <> 0 Then
' Create My Menu
Set myMenu = toolsMenu.Controls.Add(Type:=msoControlPopup)

' Create the sub Menu(s) (No myMenu = no subMenu!)
Set subMenu = myMenu.Controls.Add

With myMenu
.Caption = "My Menu"
.BeginGroup = False
With subMenu
.Caption = "sub Menu"
.BeginGroup = False
.OnAction = "'" & ThisWorkbook.Name & "'!myMacro" ' Assign Macro to Menu Item
End With
End With

'Reset
On Error GoTo 0

End If
End Sub

[gabethegrape]

Thanks fellow BC mate!

I've got this thing as far as creating a function to check the menu, but I can't seem to get it to check far enough into the menu (i.e. the submenus).


Menu1
>>Submenu1
>>Submenu2
I'm trying to check if Submenu2 exists and if it doesn't to create it, but if it does then to skip it.

Here's what I've got so far (only checks to Submenu1):


Function MenuExists(strCmdBar As String, strCtrlMenu As String, _
strCtrl As String, strCtrl2 As String) As Boolean

Dim cmdbar As CommandBar
Dim cmdCtrlMenu As CommandBarControl
Dim cmdCtrl As CommandBarControl
Dim cmdCtrl2 As CommandBarControl
Dim strCaption As String

Set cmdbar = Application.CommandBars(strCmdBar)
Set cmdCtrlMenu = cmdbar.Controls(strCtrlMenu)


MenuExists = False

For Each cmdCtrl In cmdCtrlMenu.Controls
strCaption = Replace$(Replace$(cmdCtrl.Caption, "&", ""), ".", "")
If strCaption = strCtrl Then
MenuExists = True
Exit For
End If
Next cmdCtrl

End Function

Sub test()
Debug.Print _
MenuExists("Worksheet Menu Bar", "Menu1", "Sub-menu1", "Sub-submenu1")
End Sub

Any help is greatly appreciated!
Gabe