Set Pinned Taskbar Items

[FN-GM]

I have found the below script handy if anyone would like to make sue of it. It will populate the pinned taskbar items in Windows 7. Just drop the shortcut file in the folder called Outlook Shortcut. You can change this if you wish

 

Dim Target1, Target2, fso
Target1="C:\Outlook Shortcut"
Target2="C:\Outlook Shortcut"

Set fSO = CreateObject("Scripting.FileSystemObject") 
If fso.FolderExists(Target1) Then

Set objShell = CreateObject("Shell.Application") 
Set objFolder = objShell.Namespace("C:\Outlook Shortcut") 
Set objApp = objFolder.ParseName("Outlook.lnk") 
For Each verb in objApp.Verbs() 
If verb.Name = "Pin to Tas&kbar" Then verb.DoIt 
Next

Else

Set objShell = CreateObject("Shell.Application") 
Set objFolder = objShell.Namespace("C:\Outlook Shortcut") 
Set objApp = objFolder.ParseName("Outlook.lnk") 
For Each verb in objApp.Verbs() 
If verb.Name = "Pin to Tas&kbar" Then verb.DoIt 
Next

End IF

[Valyyn]

I think that's the same base script that I used - brilliant little script

 

If it helps too, I've made a few modifications that people might find handy.

 

I've got the .vbs file running as a logon script for my Staff OU.

 

This script:

 

- removes the taskbar shortcut to Media Player no matter what

- checks to see if it has already run for that user and if so then ends (it does this by checking if the Word shortcut is pinned, so if you're not pinning Word, then change this to something else you have added)

- removes Windows Explorer from the Pin list (it re-adds it later, it's just so I can put it in the order I want)

- Pins Internet Explorer, Shortcut to our intranet site, Windows Explorer, Outlook 2010, Word 2010 and Excel 2010 to taskbar

- Pins Internet Explorer, Outlook 2010, Word 2010, shortcut to intranet and PARS to the Start Menu

 

I've got a hidden folder on the root of C: called Resources, which is where I have put all the shortcuts to make things easier - so adjust the path to where your shortcuts are.

You'll also have to change one line to point to where your start menus are (I've marked it in the code).

 

I hope I've commented it well enough and that someone finds it useful!

 

setTaskbar.zip

 

Option Explicit

Const CSIDL_COMMON_PROGRAMS = &H17
Const CSIDL_PROGRAMS = &H2
Const CSIDL_STARTMENU = &HB

Dim objShell, objFSO
Dim objCurrentUserStartFolder
Dim strCurrentUserStartFolderPath
Dim objAllUsersProgramsFolder
Dim strAllUsersProgramsPath
Dim objFolder
Dim objFolderItem
Dim colVerbs
Dim objVerb
Dim Run

Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objCurrentUserStartFolder = objShell.NameSpace (CSIDL_STARTMENU)

' - Change the below path to the location of your start menus
strCurrentUserStartFolderPath = "\\**********\netlogon\Windows7\staff\startmenu"

Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path
Run = "1"

' - Remove Media Player no matter what -

'Windows Media Player
If objFSO.FileExists("C:\Resources\Shortcuts\Windows Media Player.lnk") Then
   Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
   Set objFolderItem = objFolder.ParseName("Windows Media Player.lnk")
   Set colVerbs = objFolderItem.Verbs
   For Each objVerb in colVerbs
       If Replace(objVerb.name, "&", "") = "Unpin from Taskbar" Then objVerb.DoIt
   Next
End If


' - Check if we've already run the rest for this user -
' - If we have, then we ignore the rest of the script -
' - To do this I check the shortcut for Word. -
' - If you haven't pinned Word, then change this to something -
' - that you HAVE pinned -

If objFSO.FileExists("C:\Resources\Shortcuts\Microsoft Word 2010.lnk") Then
Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
Set objFolderItem = objFolder.ParseName("Microsoft Word 2010.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
       If Replace(objVerb.name, "&", "") = "Unpin from Taskbar" Then Run = "0"
   Next
End If


' - If we need to run, start by removing Windows Explorer -
' - Don't NEED to do this - it's just so I can get things -
' - in the order I want  -

If Run = "1" Then

'Windows Explorer
If objFSO.FileExists("C:\Resources\Shortcuts\Windows Explorer.lnk") Then
   Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
   Set objFolderItem = objFolder.ParseName("Windows Explorer.lnk")
   Set colVerbs = objFolderItem.Verbs
   For Each objVerb in colVerbs
       If Replace(objVerb.name, "&", "") = "Unpin from Taskbar" Then objVerb.DoIt
   Next
End If


' - Now we start PIN TO TASKBAR -
' - To add any more, just copy the first IF block -
' - and change the path to the new shortcut -

'Internet Explorer

If objFSO.FileExists("C:\Resources\Shortcuts\Internet Explorer.lnk") Then
   Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")

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

   Set colVerbs = objFolderItem.Verbs
   For Each objVerb in colVerbs
       If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt

   Next

End If

'ALNS Intranet
If objFSO.FileExists("C:\Resources\Shortcuts\ALNS Intranet.lnk") Then
   Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
   Set objFolderItem = objFolder.ParseName("ALNS Intranet.lnk")
   Set colVerbs = objFolderItem.Verbs
   For Each objVerb in colVerbs
       If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
   Next
End If

'Windows Explorer
If objFSO.FileExists("C:\Resources\Shortcuts\Windows Explorer.lnk") Then
Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
Set objFolderItem = objFolder.ParseName("Windows Explorer.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
	If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
End If

'Microsoft Outlook 2010
If objFSO.FileExists("C:\Resources\Shortcuts\Microsoft Outlook 2010.lnk") Then
Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
Set objFolderItem = objFolder.ParseName("Microsoft Outlook 2010.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
	If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
End If

'Microsoft Word 2010
If objFSO.FileExists("C:\Resources\Shortcuts\Microsoft Word 2010.lnk") Then
Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
Set objFolderItem = objFolder.ParseName("Microsoft Word 2010.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
	If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
End If

'Microsoft Excel 2010
If objFSO.FileExists("C:\Resources\Shortcuts\Microsoft Excel 2010.lnk") Then
Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
Set objFolderItem = objFolder.ParseName("Microsoft Excel 2010.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
	If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
Next
End If


' - Now we PIN TO START MENU -

'Internet Explorer
If objFSO.FileExists("C:\Resources\Shortcuts\Internet Explorer.lnk") Then
   Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
   Set objFolderItem = objFolder.ParseName("Internet Explorer.lnk")
   Set colVerbs = objFolderItem.Verbs
   For Each objVerb in colVerbs
       If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt
   Next
End If

'Microsoft Outlook 2010
If objFSO.FileExists("C:\Resources\Shortcuts\Microsoft Outlook 2010.lnk") Then
Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
Set objFolderItem = objFolder.ParseName("Microsoft Outlook 2010.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
	If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt
Next
End If

'Microsoft Word 2010
If objFSO.FileExists("C:\Resources\Shortcuts\Microsoft Word 2010.lnk") Then
Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
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
Next
End If

'ALNS Intranet
If objFSO.FileExists("C:\Resources\Shortcuts\ALNS Intranet.lnk") Then
   Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
   Set objFolderItem = objFolder.ParseName("ALNS Intranet.lnk")
   Set colVerbs = objFolderItem.Verbs
   For Each objVerb in colVerbs
       If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt
   Next
End If

'PARS
If objFSO.FileExists("C:\Resources\Shortcuts\PARS.lnk") Then
   Set objFolder = objShell.Namespace("C:\Resources\Shortcuts")
   Set objFolderItem = objFolder.ParseName("PARS.lnk")
   Set colVerbs = objFolderItem.Verbs
   For Each objVerb in colVerbs
       If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt
   Next
End If

End If