Solved: create custom menu w/ hyperlinks to open files

[bjacobowski]

I am attempting to create a custom menu for an add-in. In addition to several standard menu items that call macros, userforms, etc., I would also like to have menu items that open other excel workbooks (templates that are needed for the add-in). When you try to record a macro that adds a hyperlink to a menu item (through the customize menu dialog box) it only captures the creation of the button and not the hyperlink.

Here is the code I've got:
Sub Create_MStemplate_Menu()
'Create a menu with links to all excel files in specified directory

Dim lCount As Long
Dim file_Path As String
Dim MenuItem As Object
Dim MenuObject As CommandBarPopup

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

'Specify folder containing the files you need links to
file_Path = "U:\Common\PENSION\MORNINGSTAR\Excel Add-In Templates"

Set MenuObject = Application.CommandBars(1).Controls _
.Add(Type:=msoControlPopup, temporary:=True)
MenuObject.Caption = ("Mornin&gstar Template")

On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = file_Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)

'------------------------------------------------------------
'The following line opens all the files in the directory as opposed to
'creating a hyperlink. I have also tried the following method to no avail:
'menuItem.hyperlinktype = msoCommandBarButtonHyperlinkOpen
'menuItem.TooltipText = "some file"

MenuItem.OnAction = Workbooks.Open(.FoundFiles(lCount))

MenuItem.Caption = _
Replace(Replace(.FoundFiles(lCount), file_Path & "\", ""), ".xlt", "")
Next lCount
End If
End With

On Error GoTo 0

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Sub deleteMenu()
On Error Resume Next
CommandBars(1).Controls("Mornin&gstar Template").Delete
End Sub

Thanks in advance for any help!

[Bob Phillips]

If you have a menu item, why do you need a hyperlink? You could tie a macro to that menu control and open the file from therer.

[bjacobowski]

My thinking was that since it's easy to do manually, there's a way to do it w/ VBA. That it's simply a line of code that I don't know, but somebody else does. Also, the purpose is for the procedure to be dynamic--I'm not sure how many files will be in the chosen directory. I tried to put a macro in that opened the file, but it won't let you pass an argument.

[Bob Phillips]

So would my suggestion be a few lines of code with VBA, just more.

If you want it dynamic depending upon the files, are you saying you want to build the list dynamically (is that what the code does)? If so, you can set the full file name as the parameter property, tie the same macro to each menu item, and then use ActionControl to get the parameter value.

[bjacobowski]

That works! The combination of Parameter and ActionControl were the piece I was missing. Below is the code I ended up with.

Sub Create_MStemplate_Menu()

Dim lCount As Long
Dim file_Path As String
Dim MenuObject As CommandBarPopup
Dim MenuItem As Object
Dim helpIndex As CommandBarControl

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

file_Path = "U:\Common\PENSION\MORNINGSTAR\Excel Add-In Templates"

Set helpIndex = CommandBars(1).FindControl(ID:=30010)

If helpIndex Is Nothing Then
'add the menu to the end
Set MenuObject = Application.CommandBars(1).Controls _
.Add(Type:=msoControlPopup, temporary:=True)
Else
'add the menu before Help
Set MenuObject = Application.CommandBars(1).Controls _
.Add(Type:=msoControlPopup, before:=helpIndex.Index, temporary:=True)
End If
MenuObject.Caption = ("Mornin&gstar Template")

On Error Resume Next
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = file_Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'ThisWorkbook.Sheets("MS_Templates").Cells(lCount, 1).Value = .FoundFiles(lCount)
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.Parameter = .FoundFiles(lCount)
MenuItem.OnAction = "open_MS_Template"
MenuItem.Caption = _
Replace(Replace(.FoundFiles(lCount), file_Path & "\", ""), ".xlt", "")
Next lCount
End If
End With

On Error GoTo 0

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub

Sub deleteMenu()
On Error Resume Next
CommandBars(1).Controls("Mornin&gstar Template").Delete
End Sub

Sub open_MS_Template()
ActiveWorkbook.FollowHyperlink Address:=CommandBars.ActionControl.Parameter, _
NewWindow:=True
End Sub

[bjacobowski]

forgot to answer the question...

The following routine searches through the given directory and finds files of a certain type (excel files in this case), it then loops through those files to create the menu items. The parameter value is set to the file name, which is where the OnAction macro looks to find the hyperlink. The menu item's caption is set to the file name, w/ the directory and file extension removed.


On Error Resume Next
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = file_Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.Parameter = .FoundFiles(lCount)
MenuItem.OnAction = "open_MS_Template"
MenuItem.Caption = _
Replace(Replace(.FoundFiles(lCount), file_Path & "\", ""), ".xlt", "")
Next lCount
End If End With