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

Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objCurrentUserStartFolder = objShell.NameSpace (CSIDL_STARTMENU)
strCurrentUserStartFolderPath = objCurrentUserStartFolder.Self.Path
Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path

' - Remove pinned items -

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

'Windows Explorer
If objFSO.FileExists(strCurrentUserStartFolderPath & "\Programs\Accessories\Windows Explorer.lnk") Then
    Set objFolder = objShell.Namespace(strCurrentUserStartFolderPath & "\Programs\Accessories")
    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
'Windows Media Player
If objFSO.FileExists(strAllUsersProgramsPath & "\Windows Media Player.lnk") Then
    Set objFolder = objShell.Namespace(strAllUsersProgramsPath)
    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

' - Pin to Taskbar -

'Windows Explorer
If objFSO.FileExists(strCurrentUserStartFolderPath & "\Programs\Accessories\Windows Explorer.lnk") Then
	Set objFolder = objShell.Namespace(strCurrentUserStartFolderPath & "\Programs\Accessories")
	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

'Internet Explorer
If objFSO.FileExists(strCurrentUserStartFolderPath & "\Programs\Internet Explorer.lnk") Then
    Set objFolder = objShell.Namespace(strCurrentUserStartFolderPath & "\Programs")
    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

'Mozilla Firefox
If objFSO.FileExists(strAllUsersProgramsPath & "\Mozilla Firefox\Mozilla Firefox.lnk") Then
	Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Mozilla Firefox")
	Set objFolderItem = objFolder.ParseName("Mozilla Firefox.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(strAllUsersProgramsPath & "\Microsoft Office\Microsoft Word 2010.lnk") Then
	Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Microsoft Office")
	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(strAllUsersProgramsPath & "\Microsoft Office\Microsoft Excel 2010.lnk") Then
	Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Microsoft Office")
	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

'Microsoft Outlook 2010
If objFSO.FileExists(strAllUsersProgramsPath & "\Microsoft Office\Microsoft Outlook 2010.lnk") Then
	Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Microsoft Office")
	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

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

'Delete the script
DeleteSelf

Sub DeleteSelf()       
        Dim objFSO
        'Create a File System Object
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        'Delete the currently executing script
        objFSO.DeleteFile WScript.ScriptFullName
        Set objFSO = Nothing
End Sub

