VB Script to add taskbar icons not working

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • oscarcour
    New Member
    • Jul 2015
    • 1

    VB Script to add taskbar icons not working

    I have a script to add taskbar icons on every new user icon. It works, except for the Microsoft Office icons.
    Here is the script:

    Code:
    Option Explicit
    
    Const CSIDL_COMMON_PROGRAMS = &H17
    Const CSIDL_PROGRAMS = &H2
    Const CSIDL_STARTMENU = &HB
    Const CSIDL_CURRENT_USER_DESKTOP = &H10
    Const CSIDL_PUBLIC_DESKTOP = &H19
    
    Dim objShell, objFSO
    
    Dim objCurrentUserStartFolder
    Dim strCurrentUserStartFolderPath
    
    Dim objCurrentUserDesktopFolder
    Dim strCurrentUserDesktopFolderPath
    
    Dim objAllUsersProgramsFolder
    Dim strAllUsersProgramsPath
    
    Dim objPublicDesktopFolder
    Dim strPublicDesktopFolderPath
    
    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 objCurrentUserDesktopFolder = objShell.NameSpace (CSIDL_CURRENT_USER_DESKTOP)
    strCurrentUserDesktopFolderPath = objCurrentUserDesktopFolder.Self.Path
    
    Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
    strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path
    
    Set objPublicDesktopFolder = objShell.NameSpace (CSIDL_PUBLIC_DESKTOP)
    strCurrentUserDesktopFolderPath = objPublicDesktopFolder.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
    
    'Google Chrome
    If objFSO.FileExists(strAllUsersProgramsPath & "\Google Chrome\Google Chrome.lnk") Then
        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, "&", "") = "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 -
    
    'Mozilla Firefox
    If objFSO.FileExists("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Mozilla Firefox.lnk") Then
    	Set objFolder = objShell.Namespace("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\")
    	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
    
    '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
    
    'Microsoft Office Word
    If objFSO.FileExists("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\Microsoft Office 2013\Word 2013.lnk") Then
    	Set objFolder = objShell.Namespace("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\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 Office Excel
    If objFSO.FileExists("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\Microsoft Office 2013\Excel 2013.lnk") Then
    	Set objFolder = objShell.Namespace("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\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 Office Powerpoint
    If objFSO.FileExists("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\Microsoft Office 2013\PowerPoint 2013.lnk") Then
    	Set objFolder = objShell.Namespace("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\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
    
    ' - Remove IE shortcuts from start menu -
    
    'Internet Explorer
    If objFSO.FileExists(strCurrentUserStartFolderPath & "\Programs\Internet Explorer.lnk") Then
        objFSO.DeleteFile(strCurrentUserStartFolderPath & "\Programs\Internet Explorer.lnk")
    End If
    
    'Internet Explorer 64-bit
    If objFSO.FileExists(strCurrentUserStartFolderPath & "\Programs\Internet Explorer (64-bit).lnk") Then
        objFSO.DeleteFile(strCurrentUserStartFolderPath & "\Programs\Internet Explorer (64-bit).lnk")
    End If
    
    
    ' - Remove Thunderbird from current user desktop -
    If objFSO.FileExists(strCurrentUserDesktopFolderPath & "\Mozilla Thunderbird.lnk") Then
        objFSO.DeleteFile(strCurrentUserDesktopFolderPath & "\Mozilla Thunderbird.lnk")
    End If
    
    ' - Remove Thunderbird from public desktop -
    If objFSO.FileExists(strPublicDesktopFolderPath& "\Mozilla Thunderbird.lnk") Then
        objFSO.DeleteFile(strPublicDesktopFolderPath& "\Mozilla Thunderbird.lnk")
    End If
    
    ' - Remove Google Chrome from current user desktop -
    If objFSO.FileExists(strCurrentUserDesktopFolderPath & "\Google Chrome.lnk") Then
        objFSO.DeleteFile(strCurrentUserDesktopFolderPath & "\Google Chrome.lnk")
    End If
    
    ' - Remove Google Chrome from Public desktop -
    If objFSO.FileExists(strPublicDesktopFolderPath & "\Google Chrome.lnk") Then
        objFSO.DeleteFile(strPublicDesktopFolderPath & "\Google Chrome.lnk")
    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
    And here is the batch file that places it:

    Code:
    mkdir "C:\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup"
    copy /y SetShortcuts.vbs "C:\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup"

    Any ideas why this wouldn't be working?
    Last edited by Rabbit; Jul 24 '15, 03:41 PM. Reason: Please use [code] and [/code] tags when posting code or formatted data.
Working...