'' Name: Win7pinPrograms.vbs
'' Description: Pins Programs to the Taskbar OR Start Menu
'' Modified: 12/21/2011

On Error Resume Next

Const CSIDL_COMMON_PROGRAMS = &H17 
Const CSIDL_PROGRAMS = &H2 

Set WshShell = WScript.CreateObject("WScript.Shell")
Set objShell = CreateObject("Shell.Application") 
Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS) 
Set objUsersProgramsFolder = objShell.NameSpace(CSIDL_PROGRAMS)
set FileSys = CreateObject("Scripting.FileSystemObject")

strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path
strUsersProgramsPath = objUsersProgramsFolder.Self.Path

' ===== For Google Chrome =====
If FileSys.FileExists(strAllUsersProgramsPath & "\Google Chrome\" & "Google Chrome.lnk") Then
''If Google Chrome Installed, Pin to Start

Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Google Chrome")
Set objFolderItem = objFolder.ParseName("Google Chrome.lnk") 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt 
    ''If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt 
Next

End If

' ===== For Office 2010 Applications =====
If FileSys.FileExists(strAllUsersProgramsPath & "\Microsoft Office\" & "Microsoft Word 2010.lnk") Then
  ''If 2010 installed, Create Office 2010 Shorcuts
  
Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Microsoft Office") 

Set objFolderItem = objFolder.ParseName("Microsoft Access 2010.lnk") 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt 
    ''If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt 
Next

Set objFolderItem = objFolder.ParseName("Microsoft Excel 2010.lnk") 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt 
    ''If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt 
Next

Set objFolderItem = objFolder.ParseName("Microsoft PowerPoint 2010.lnk") 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt 
    ''If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt 
Next

Set objFolderItem = objFolder.ParseName("Microsoft Publisher 2010.lnk") 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt 
    ''If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt 
Next

Set objFolderItem = objFolder.ParseName("Microsoft Word 2010.lnk") 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt 
    ''If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt 
Next
End If


' ===== For Office 2007 Applications =====
If FileSys.FileExists(strAllUsersProgramsPath & "\Microsoft Office\" & "Microsoft Office Word 2007.lnk") Then
  ''If 2007 installed, Create Office 2007 Shorcuts
  
Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Microsoft Office") 
  
Set objFolderItem = objFolder.ParseName("Microsoft Office Access 2007.lnk") 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt 
    ''If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt 
Next

Set objFolderItem = objFolder.ParseName("Microsoft Office Excel 2007.lnk") 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt 
    ''If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt 
Next

Set objFolderItem = objFolder.ParseName("Microsoft Office PowerPoint 2007.lnk") 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt 
    ''If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt 
Next

Set objFolderItem = objFolder.ParseName("Microsoft Office Publisher 2007.lnk") 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt 
    ''If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt 
Next

Set objFolderItem = objFolder.ParseName("Microsoft Office Word 2007.lnk") 
Set colVerbs = objFolderItem.Verbs 
For Each objVerb in colVerbs 
    If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt 
    ''If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt 
Next
End If