Pinned Items on windows 7 - modified

[caffrey]

Probably needs some other error trapping but I modified the original VBS script to add pinned items to the start menu, to accommodate for different versions of office on different OSs (office 2007 and office 2010 on x86 or x64) (yes I'm aware that the network should be uniform )

I'm not the best at scripting so might be a bit rubbish.

I also included an example of another program (vlc) to show how to add any others - maybe handy to someone - just thought I'd share.

 

pin.vbs

 

 

Dim ObjFolder, ObjFolderItem, colVerbs, objverb, objshell, objfso, folderpath, folderpathvlc

Set objShell = CreateObject("Shell.Application")
set objfso = createobject("Scripting.FileSystemObject")

if objfso.folderexists ("C:\Program Files\Microsoft Office\Office12") then

folderpath="C:\Program Files\Microsoft Office\Office12"

elseif objfso.folderexists ("C:\Program Files\Microsoft Office\Office14") then 

folderpath="C:\Program Files\Microsoft Office\Office14"

elseif objfso.folderexists ("C:\Program Files (x86)\Microsoft Office\Office12") then 

folderpath="C:\Program Files (x86)\Microsoft Office\Office12"

elseif objfso.folderexists ("C:\Program Files (x86)\Microsoft Office\Office14") then 

folderpath="C:\Program Files (x86)\Microsoft Office\Office14"

End IF

if objfso.folderexists ("C:\Program Files (x86)\VideoLAN\VLC") then

folderpathvlc="C:\Program Files (x86)\VideoLAN\VLC"

elseif objfso.folderexists ("C:\Program Files\VideoLAN\VLC") then 

folderpathvlc="C:\Program Files\VideoLAN\VLC"

End If

Set objFolder = objShell.Namespace(folderpath)
Set objFolderItem = objFolder.ParseName("POWERPNT.exe")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt
Next

Set objFolder = objShell.Namespace(folderpath)
Set objFolderItem = objFolder.ParseName("WINWORD.exe")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt
Next

Set objFolder = objShell.Namespace(folderpath)
Set objFolderItem = objFolder.ParseName("MSPUB.exe")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt
Next

Set objFolder = objShell.Namespace(folderpath)
Set objFolderItem = objFolder.ParseName("EXCEL.exe")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt
Next

Set objFolder = objShell.Namespace(folderpathvlc)
Set objFolderItem = objFolder.ParseName("VLC.exe")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt
Next


WScript.Quit