Works on Windows 7 and Windows Vista. See the video (which has no audio) below for a demonstration.



You can either comment on YouTube or comment right here on this site

The Windows 7 and Windows Vista Start Menus allow you to pin items to them, but you can only one have one per command line. So you can only have one shortcut for 'cmd.exe'.

The simplest way around this is to stick unique arguments on the end, e.g.

cmd /c echo 1
cmd /c echo 2
cmd /c echo 3

The provided script (extendmenu.vbs) creates shortcuts like above, gives them a blank icon, and pins them to your Start Menu.

Each new shortcut has a filename consisting of only spaces
(and an increased number of chr(0160) characters, which are a kind of space).
Due to the way windows compares the filenames, each link has to be placed in its own directory.

The blank.ico is as it sounds, a blank icon so that the shortcuts don't display one.

Unfortunately I don't have a program which just exits. I would be prefer to use one over cmd.exe, since it does pop up a window. It does however already exist on all your systems and exits itself fairly fast.




Below is the script, which could be improved but does work.

When run the user is asked to go through each option of what to do with the shortcut to find the correct term for pinning it to the start menu, this only occurs once per run, and helps keep the script flexible.

For instance it isn't limited to the english version of Windows 7 where the true name of the Pin item is "Pin to Start Men&u" or in Windows Vista where it is "P&in to Start Menu".

Obviously in other languages it won't be either of those, yet it should still work.

---

' Start Menu Extender by Lewis from www.zoril.co.uk 19Sep09
' Works on Windows 7 and Windows Vista
' Should also be valid for non english languages
Dim WSHShell, Shell, FSO
Set Shell    = WScript.CreateObject("Shell.Application")
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set FSO      = WScript.CreateObject("Scripting.FileSystemObject")

Dim AppTitle
AppTitle = "Start Menu Extender"

L_contOrQuit_MsgBox_Message_Text = "This script is about to create the" & _
                       vbcrlf & "blank shortcuts required to extend" & _
                       vbcrlf & "your start menu."
Call contOrQuit()

' Current Location
Dim CurrentPath, BlankPath, CurrentBlankPath, L_MakeShortcut_Name, L_MakeShortcut_Targ
CurrentPath = FSO.GetAbsolutePathName(".")
BlankPath = CurrentPath & "\Blank"

If FSO.FolderExists(BlankPath) Then
	L_contOrQuit_MsgBox_Message_Text = "You have already run this, we need to tidy up." & _
	                          vbcrlf & "Going to delete [ " & BlankPath & " ]"
	Call contOrQuit()
	FSO.DeleteFolder(BlankPath)
End If
FSO.CreateFolder(BlankPath)

' Initial shortcut to get vars
CurrentBlankPath = BlankPath & "\0"
FSO.CreateFolder(CurrentBlankPath)
Set objFolder = Shell.Namespace(CurrentBlankPath)
L_MakeShortcut_Name = " .lnk"
L_MakeShortcut_Targ = "%windir%\system32\cmd.exe"
L_MakeShortcut_Args = "/c echo 0"
Call MakeShortcut()


' Ask user which one we want to make it more multilingual
WScript.Echo "If you are Adding blanks," & _
    vbcrlf & "keep saying No until you get" & _
    vbcrlf & "[ Pin to Start Menu ]" & _
    vbcrlf &  _
    vbcrlf & "If you are Removing blanks," & _
    vbcrlf & "keep saying No until you get" & _
    vbcrlf & "[ Unpin from Start Menu ]"

Dim PinString, intDoIt
PinString = "blank"

Set objFolderItem = objFolder.ParseName(" .lnk")

For Each x In objFolderItem.Verbs
	L_SelectVerb_MsgBox_Message_Text = "Do you want to " & vbcrlf & "[ " & Replace(x.Name, "&", "") & " ]?"
	intDoIt = MsgBox(L_SelectVerb_MsgBox_Message_Text, vbYesNo + vbInformation, AppTitle)
	If intDoIt = vbYes Then PinString = x.Name
	If PinString <> "blank" Then Exit For
Next

If PinString = "blank" Then
	WScript.Echo "Nothing was selected. Quitting."
	WScript.Quit
End If

L_contOrQuit_MsgBox_Message_Text = "About to use: " & vbcrlf & vbcrlf & Replace(PinString, "&", "")
Call contOrQuit()

' Pin that first shorcut
Call PinIt()

Dim counter, makeMore
counter = 1
makeMore = MsgBox("Again?", vbYesNo + vbQuestion, AppTitle)

' Keep creating until satisfied
While makeMore = vbYes
	CurrentBlankPath = BlankPath & "\" & counter
	FSO.CreateFolder(CurrentBlankPath)
	Set objFolder = Shell.Namespace(CurrentBlankPath)
	L_MakeShortcut_Name = ""
	For blanks = 0 to counter
		L_MakeShortcut_Name = L_MakeShortcut_Name & chr(0160)
	Next
	L_MakeShortcut_Name = L_MakeShortcut_Name & " .lnk"
	L_MakeShortcut_Targ = "%windir%\system32\cmd.exe"
	L_MakeShortcut_Args = "/c echo " & counter
	Call MakeShortcut()
	Call PinIt()
	counter = counter + 1
	makeMore = MsgBox("Again?", vbYesNo + vbQuestion, AppTitle)
Wend

' Pins items
Sub PinIt()
	Set objFolderItem = objFolder.ParseName(L_MakeShortcut_Name)
	' unfortunate need to scan through again
	For Each objVerb in objFolderItem.Verbs
		If objVerb.name = PinString Then objVerb.DoIt
	Next
End Sub

' Create shortcuts
Sub MakeShortcut()
	Dim NewShortcut
	Set NewShortcut = WSHShell.CreateShortcut(CurrentBlankPath & "\" & L_MakeShortcut_Name)
	NewShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings( L_MakeShortcut_Targ )
	NewShortcut.Arguments = L_MakeShortcut_Args
	NewShortcut.WorkingDirectory = WSHShell.ExpandEnvironmentStrings( "%windir%")
	NewShortcut.WindowStyle = 4
	NewShortcut.IconLocation = CurrentPath & "\blank.ico"
	NewShortcut.Save
End Sub

' check to run
Sub contOrQuit()
	Dim intDoIt
	intDoIt = MsgBox(L_contOrQuit_MsgBox_Message_Text, vbOKCancel + vbQuestion, AppTitle)
	If intDoIt = vbCancel Then WScript.Quit
End Sub

[19/09/2009]

Note (partly to self): use %CMDCMDLINE% instead of %windir%\system32\cmd.exe

[02/05/2010]