As promised in my previous post, here is my current VBScript for configuring the Windows 7 Start Menu and Taskbar. Not beautiful, but certainly functional. My thanks to JuliusPIV and cogumel0 for doing the heavy lifting that made this script possible.
Note that you really will need to set the Group Policy option to turn off the Start Menu program history if you want Start Menu pinning to be at all effective in streamlining the Windows 7 “first time” GUI.
'==========================================================================
'
' NAME: Pin & Unpin items to/from Start Menu & Taskbar
'
' AUTHOR: J. Greg Mackinnon
' DATE : 2013-01-31
'
' COMMENT: Derived from code by JuliusPIV found here:
' http://social.technet.microsoft.com/Forums/en/w7itproinstall/thread/73eb1c0a-fc78-4ae7-ba6d-356d9a9a5328
'
' To add items to Start Menu or Taskbar, add a variable defining the
' path to the original link in the variables section, then add that
' variable to the "aPinSM", "aPinTB", or "aUnpinTB" arrays.
'
' Note that not all links (such as filesystem shortcuts) can be pinned.
'
' Uncomment "debugecho" lines to troubleshoot.
'
'==========================================================================
option explicit
'=-=-=-=-=-=-=-=-=-=-=-=-=
' CONSTANTS
'=-=-=-=-=-=-=-=-=-=-=-=-=
'List of "Shell Special Folder Constants" used in the script. See:
'http://msdn.microsoft.com/en-us/library/windows/desktop/bb774096(v=vs.85).aspx
const ssfAPPDATA = &H1a
const ssfCOMMONPROGRAMS = &H17
const ssfPROGRAMFILESx86 = &H30
const ssfPROGRAMS = &H2
const ssfSYSTEM = &H25
const ssfWINDOWS = &H24
'=-=-=-=-=-=-=-=-=-=-=-=-=
' OBJECTS
'=-=-=-=-=-=-=-=-=-=-=-=-=
dim fso, oShell, oShortcut
set fso = CreateObject("Scripting.FileSystemObject")
set oShell = CreateObject("Shell.Application")
'=-=-=-=-=-=-=-=-=-=-=-=-=
' VARIABLES
'=-=-=-=-=-=-=-=-=-=-=-=-=
dim aPinSM, aPinTB, aUnpinTB
dim bEchoOut, bPinItem
dim sAUP, sUP, sRAD, sPFx86, sSys32, sItem, sScriptHost, sFileName
dim sGC, sMOW, sMOE, sMOPP, sMOON, sMOO, sOC, sFZ, sPT, sProj, sCalc, sSnip, sPDN, sMag, sKey, sWMP
'Configure variables for well known folders:
sRAD = oShell.NameSpace(ssfAPPDATA).Self.Path & "\" 'Roaming AppData
sAUP = oShell.NameSpace(ssfCOMMONPROGRAMS).Self.Path & "\" 'Start Menu Programs - All Users
sUP = oShell.NameSpace(ssfPROGRAMS).Self.Path & "\" 'Start Menu Programs - Current User
'sPFx86 = oShell.NameSpace(ssfPROGRAMFILESx86).Self.Path & "\" 'Program Files (x86)
'sSys32 = oShell.NameSpace(ssfSYSTEM).Self.Path & "\" '%WinDir%\system32
'List of links to be added to the Start Menu or Taskbar, relative to:
' C:\ProgramData\Microsoft\Windows\Start Menu\Programs
sGC = sAUP & "Google Chrome\Google Chrome.lnk"
sMOW = sAUP & "Microsoft Office 2013\Word 2013.lnk"
sMOE = sAUP & "Microsoft Office 2013\Excel 2013.lnk"
sMOPP = sAUP & "Microsoft Office 2013\PowerPoint 2013.lnk"
sMOON = sAUP & "Microsoft Office 2013\Onenote 2013.lnk"
sMOO = sAUP & "Microsoft Office 2013\Outlook 2013.lnk"
sOC = sAUP & "Oracle Calendar\Oracle Calendar.lnk"
sFZ = sAUP & "FileZilla FTP Client\FileZilla.lnk"
sPT = sAUP & "PuTTY\PuTTY.lnk"
sProj = sAUP & "Accessories\displayswitch.lnk"
sCalc = sAUP & "Accessories\Calculator.lnk"
sSnip = sAUP & "Accessories\Snipping Tool.lnk"
sPDN = sAUP & "Paint.NET.lnk"
sMag = sUP & "Accessories\Accessibility\Magnify.lnk"
sKey = sUP & "Accessories\Accessibility\On-Screen Keyboard.lnk"
sWMP = sRAD & "Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar\Windows Media Player.lnk"
'Arrays containing links to be added to StartMenu or Taskbar, or to be removed from the Taskbar:
aPinSM = Array(sOC,sFZ,sPT,sPDN,sSnip,sCalc,sProj,sMag,sKey)
aPinTB = Array(sGC,sMOW,sMOE,sMOPP,sMOON)
aUnpinTB = Array(sWMP,sMOW,sMOPP)
'=-=-=-=-=-=-=-=-=-=-=-=-=
' FUNCTIONS AND SUBS
'=-=-=-=-=-=-=-=-=-=-=-=-=
function PinSM(shortcut)
dim oFolder, oFolderItem
dim sFolder, sFile
dim colVerbs
dim itemverb
sFolder = fso.GetParentFolderName(shortcut)
sFile = fso.GetFileName(shortcut)
'debugecho "Pinning " & sFolder & "\" & sFile & " to Start Menu."
Err.Clear
set oFolder = oShell.NameSpace(sFolder)
set oFolderItem = oFolder.ParseName(sFile)
set colVerbs = oFolderItem.Verbs
for each itemverb in oFolderItem.Verbs
if Replace(itemverb.name, "&", "") = "Pin to Start Menu" then itemverb.DoIt
next
end function
function PinTB(shortcut)
dim sFolder, sFile
dim oFolder, oFolderItem
dim colVerbs, itemverb
sFolder = fso.GetParentFolderName(shortcut)
sFile = fso.GetFileName(shortcut)
'debugecho "Pinning " & sFolder & "\" & sFile & " to Taskbar."
Err.Clear
set oFolder = oShell.NameSpace(sFolder)
set oFolderItem = oFolder.ParseName(sFile)
set colVerbs = oFolderItem.Verbs
for each itemverb in oFolderItem.Verbs
if Replace(itemverb.name, "&", "") = "Pin to Taskbar" then itemverb.DoIt
next
end function
function UnpinTB(shortcut)
dim sFolder, sFile
dim oFolder, oFolderItem
dim colVerbs, itemverb
sFolder = fso.GetParentFolderName(shortcut)
sFile = fso.GetFileName(shortcut)
'debugecho "Unpinning " & sFolder & "\" & sFile & " from Taskbar."
Err.Clear
set oFolder = oShell.NameSpace(sFolder)
set oFolderItem = oFolder.ParseName(sFile)
set colVerbs = oFolderItem.Verbs
for each itemverb in oFolderItem.Verbs
if Replace(itemverb.name, "&", "") = "Unpin from Taskbar" then itemverb.DoIt
next
end function
function debugecho(msg)
if bEchoOut then
wscript.echo msg
end if
end function
sub Main
for each sItem in aUnpinTB
if not fso.FileExists(sItem) then
bPinItem = false
'debugecho "File, " & sItem & ", to unpin does not exist."
'debugecho "Please check the input and try again."
else
UnpinTB(sItem)
end if
next
for each sItem in aPinSM
if not fso.FileExists(sItem) then
bPinItem = false
'debugecho "File, " & sItem & ", to pin does not exist."
'debugecho "Please check the input and try again."
else
PinSM(sItem)
end if
next
for each sItem in aPinTB
if not fso.FileExists(sItem) then
bPinItem = false
'debugecho "File, " & sItem & ", to pin does not exist."
'debugecho "Please check the input and try again."
else
PinTB(sItem)
end if
next
end sub
'=-=-=-=-=-=-=-=-=-=-=-=-=
' MAIN BODY
'=-=-=-=-=-=-=-=-=-=-=-=-=
'Suppress echo if we are in WScript:
sScriptHost = LCase(Wscript.FullName)
if Right(sScriptHost, 11) = "wscript.exe" then
bEchoOut = false
else
bEchoOut = true
end if
call Main