none
How to add/remove items from taskbar for ALL Users

    Question

  • So i have this script currently

      

    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
    NEXT

    '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 Outlook 2013
    If objFSO.FileExists(strAllUsersProgramsPath & "\Microsoft Office 2013\Outlook 2013.lnk") Then
        Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Microsoft Office 2013")
        Set objFolderItem = objFolder.ParseName("Outlook 2013.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 2013
    If objFSO.FileExists(strAllUsersProgramsPath & "\Microsoft Office 2013\Word 2013.lnk") Then
        Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Microsoft Office 2013")
        Set objFolderItem = objFolder.ParseName("Word 2013.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 2013
    If objFSO.FileExists(strAllUsersProgramsPath & "\Microsoft Office 2013\Excel 2013.lnk") Then
        Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Microsoft Office 2013")
        Set objFolderItem = objFolder.ParseName("Excel 2013.lnk")
        Set colVerbs = objFolderItem.Verbs
        For Each objVerb in colVerbs
            If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
        Next
    End If

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

    But it only does it for currently logged on user, when we need to run this script with no user logged in during a maintenance window. Wondering if someone can help me set this up.


    • Edited by speclou Tuesday, August 4, 2015 7:45 PM
    Tuesday, August 4, 2015 7:40 PM

Answers