VBS to pin and unpin icons

I just found Rob's script to pin/unpin icons from the taskbar and Star Menu but when I run it, I get

http://blog.experts-exchange.com/ee-blog/pin-unpin-start-menu-taskbar-items-windows-7/

Path not found Line 55 and Char 21.  That is the For statement.  I left everything default as far as the notepad and calc icons so that I could test it to pin and unpin just those for test.  

Am I missing something?
murrycAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Wayne Taylor (webtubbs)Commented:
It's working fine for me on my Win7 computer. It looks like it can't find the folder for the pinned items. Place this before the For loop and check that the returned folder exists...

    MsgBox strPinLocation

Wayne
0
zalazarCommented:
You may use the following script I created which does accomplish it also.
'*********************************************************************
'* Pin Shortcuts
'*********************************************************************
Const PinTask = "Pin to Taskbar"
Const PinStart = "Pin to Start Menu"
Const UnpTask = "Unpin from Taskbar"
Const UnpStart = "Unpin from Start Menu"

Dim fso, objShell, strShortcut

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")

' Pin Word 2010 to taskbar
strShortcut = "C:\Program Files (x86)\Microsoft Office\Office14\WINWORD.EXE"
call PinItem(strShortcut, PinTask)

' Pin Excel 2010 to taskbar
strShortcut = "C:\Program Files (x86)\Microsoft Office\Office14\EXCEL.EXE"
call PinItem(strShortcut, PinTask)


Set objShell = Nothing
Set fso = Nothing

Wscript.quit 0
'---------------------------------------------------------------------
' --------  SUBS  --------
'---------------------------------------------------------------------
Sub PinItem(sShortcut, sPinType)
  Dim sFolderPath, sFileName
  Dim objFolder, objFolderItem, colVerbs, objVerb

  If fso.FileExists(sShortcut) = False Then
    Exit Sub
  End If

  sFolderPath = fso.GetParentFolderName(sShortcut)
  sFileName = fso.GetFileName(sShortcut)

  Set objFolder = objShell.Namespace(sFolderPath)
  Set objFolderItem = objFolder.ParseName(sFileName)
  Set colVerbs = objFolderItem.Verbs
  For Each objVerb in colVerbs
    If Replace(objVerb.name, "&", "") = sPinType Then objVerb.DoIt
  Next

  Set colVerbs = Nothing
  Set objFolderItem = Nothing
  Set objFolder = Nothing
End Sub

Open in new window

The variable strShortcut has to be set to the executable.
In this case I pin Word 2010 and Excel 2010 to the taskbar.
You can also call the sub with
call PinItem(strShortcut, PinStart)
to pin to the start menu.
0
RobSampsonCommented:
Hi, I'm going to assume it is having trouble finding this folder:
%APPDATA%\Microsoft\Internet Explorer\Quick Launch\User Pinned\

If you paste that path into a Windows Explorer address bar, does it find it?  Maybe your User Pinned folder exists somewhere else, although I wouldn't be sure why that's the case.....

Rob.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

murrycAuthor Commented:
Rob, you where correct. Zalazar, thanks for the alternative solution.
0
RobSampsonCommented:
So did manually creating that folder work, or did you have that folder somewhere else? Maybe I should add to the script to create that folder if it doesn't exist.

Rob.
0
murrycAuthor Commented:
The folder did not exist for some reason.  Adding it would be great!

Something else that would help.  Can you have the script not prompt anything?  I plan on running it as part of an application installer on all of my domain users.  The user will execute the installer and it will places the application files and then pin the icon for me.
0
RobSampsonCommented:
Hi, I have added a routine to create the directory structure if it doesn't exist.  In terms of making the script silent, you can either comment out all of the WScript.Echo lines by putting an apostrophe at the start of each line, or you can have the installer run
wscript.exe //B <yourscript>

Regards,

Rob.

' Specify the file paths of the file to pin or unpin
' The second element on each line of the array can be either "Both", "Start Menu",  or
' "Taskbar" to specify the target of each operation.
' If strMode = "unpin", you can use "unpin_all" in the third element of the array to unpin
' all items from the Taskbar or Start Menu.
' SYNTAX IS <mode>, <location>, <filename> WITH THREE ELEMENTS PER ACTION
arrActions = Array( _
    "unpin", "Both", "unpin_all", _
    "pin", "Start Menu", "C:\Windows\Notepad.exe", _
    "pin", "Taskbar", "C:\Windows\Calc.exe" _
)

For intAction = 0 To (UBound(arrActions) - 2) Step 3

    arrFileNames = Array(arrActions(intAction + 2))
    
    'strMode can be "Pin" or "Unpin"
    strMode = arrActions(intAction)
    
    'strLocation can be "Start Menu" or "Taskbar" or "Both"
    strLocation = arrActions(intAction + 1)
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShellApp = CreateObject("Shell.Application")
    Set objShell = CreateObject("WScript.Shell")
    If LCase(strLocation) = "both" Then
        arrLocations = Array("Start Menu", "Taskbar")
    Else
        arrLocations = Array(strLocation)
    End If
    
    For Each strLocation In arrLocations
        If LCase(strMode) <> "pin" And LCase(strMode) <> "unpin" Then
            WScript.Echo "Mode is incorrect. Please set to ""pin"" or ""unpin""."
            WScript.Quit
        ElseIf LCase(strLocation) <> "start menu" And LCase(strLocation) <> "taskbar" Then
            WScript.Echo "Location is incorrect. Please set to ""Start Menu"" or ""Taskbar""."
            WScript.Quit
        Else
            strMode = LCase(strMode)
            If strMode = "pin" Then
                strVerb = LCase(strMode & " to " & strLocation)
                strMessage = " has been " & strMode & "ned to the " & strLocation & "."
            ElseIf strMode = "unpin" Then
                strVerb = LCase(strMode & " from " & strLocation)
                strMessage = " has been " & strMode & "ned from the " & strLocation & "."
            End If
            
            For Each strFilePath In arrFileNames
                If LCase(strFilePath) = "unpin_all" And strMode = "unpin" Then
                    strPinLocation = objShell.ExpandEnvironmentStrings("%APPDATA%") & _
                        "\Microsoft\Internet Explorer\Quick Launch\User Pinned\" & _
                        Replace(strLocation, " ", "") & "\"
                    CreateLocalDirectoryStructure strPinLocation
                    For Each objFile In objFSO.GetFolder(strPinLocation).Files
                        strFullPath = objFile.Path
                        'Set objFile = objFSO.GetFile(objFile.Path)
                        Set objFolder = objShellApp.Namespace(objFile.ParentFolder & "\")
                        Set objFolderItem = objFolder.ParseName(objFile.Name)
                        Set colVerbs = objFolderItem.Verbs
                        For Each objVerb In colVerbs
                            If LCase(Replace(objVerb.name, "&", "")) = strVerb Then
                                objVerb.DoIt
                                WScript.Echo strFullPath & strMessage
                            End If
                        Next
                    Next
                Else
                    If objFSO.FileExists(strFilePath) = True Then
                        Set objFile = objFSO.GetFile(strFilePath)
                        Set objFolder = objShellApp.Namespace(objFile.ParentFolder & "\")
                        Set objFolderItem = objFolder.ParseName(objFile.Name)
                        Set colVerbs = objFolderItem.Verbs
                        blnOptionFound = False
                        For Each objVerb In colVerbs
                            If LCase(Replace(objVerb.name, "&", "")) = strVerb Then
                                objVerb.DoIt
                                blnOptionFound = True
                            End If
                        Next
                        If blnOptionFound = True Then
                            WScript.Echo strFilePath & strMessage
                        Else
                            WScript.Echo "Unable to " & strMode & " " & strFilePath & " from the " & strLocation & ". The verb does not exist."
                        End If
                    Else
                        WScript.Echo "Could not find " & strFilePath
                    End If
                End If
            Next
        End If
    Next
Next

Sub CreateLocalDirectoryStructure(strPath)
	' Check if the path is a local file path
	'WScript.Echo "Argument passed for local creation: " & strPath
	If Mid(strPath, 2, 2) = ":\" Then
		If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)
		arrBits = Split(strPath, "\")
		strSubPath = arrBits(0)
		If UBound(arrBits) > 0 Then
			For intBit = 1 To UBound(arrBits)
				strSubPath = strSubPath & "\" & arrBits(intBit)
				'WScript.Echo strSubPath & " is being checked..."
				If objFSO.FolderExists(strSubPath) = False Then
					objFSO.CreateFolder(strSubPath)
					'WScript.Echo strSubPath & " created."
				Else
					'WScript.Echo strSubPath & " exists."
				End If
			Next
		End If
	Else
		WScript.Echo "A local directory path was not passed to the CreateLocalDirectoryStructure procedure."
	End If
End Sub

Open in new window

0
murrycAuthor Commented:
Thanks Rob!  Is it possible to pin items based on variables?  For instance, I need to pin an item found in the %UserProfile%.  I tried and it fails.
0
RobSampsonCommented:
OK, I've added this at line 50:
            	strFilePath = objShell.ExpandEnvironmentStrings(strFilePath)

Open in new window


so that should work.

Regards,

Rob.

' Specify the file paths of the file to pin or unpin
' The second element on each line of the array can be either "Both", "Start Menu",  or
' "Taskbar" to specify the target of each operation.
' If strMode = "unpin", you can use "unpin_all" in the third element of the array to unpin
' all items from the Taskbar or Start Menu.
' SYNTAX IS <mode>, <location>, <filename> WITH THREE ELEMENTS PER ACTION
arrActions = Array( _
    "unpin", "Both", "unpin_all", _
    "pin", "Start Menu", "C:\Windows\Notepad.exe", _
    "pin", "Taskbar", "C:\Windows\Calc.exe" _
)

For intAction = 0 To (UBound(arrActions) - 2) Step 3

    arrFileNames = Array(arrActions(intAction + 2))
    
    'strMode can be "Pin" or "Unpin"
    strMode = arrActions(intAction)
    
    'strLocation can be "Start Menu" or "Taskbar" or "Both"
    strLocation = arrActions(intAction + 1)
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShellApp = CreateObject("Shell.Application")
    Set objShell = CreateObject("WScript.Shell")
    If LCase(strLocation) = "both" Then
        arrLocations = Array("Start Menu", "Taskbar")
    Else
        arrLocations = Array(strLocation)
    End If
    
    For Each strLocation In arrLocations
        If LCase(strMode) <> "pin" And LCase(strMode) <> "unpin" Then
            WScript.Echo "Mode is incorrect. Please set to ""pin"" or ""unpin""."
            WScript.Quit
        ElseIf LCase(strLocation) <> "start menu" And LCase(strLocation) <> "taskbar" Then
            WScript.Echo "Location is incorrect. Please set to ""Start Menu"" or ""Taskbar""."
            WScript.Quit
        Else
            strMode = LCase(strMode)
            If strMode = "pin" Then
                strVerb = LCase(strMode & " to " & strLocation)
                strMessage = " has been " & strMode & "ned to the " & strLocation & "."
            ElseIf strMode = "unpin" Then
                strVerb = LCase(strMode & " from " & strLocation)
                strMessage = " has been " & strMode & "ned from the " & strLocation & "."
            End If
            
            For Each strFilePath In arrFileNames
            	strFilePath = objShell.ExpandEnvironmentStrings(strFilePath)
                If LCase(strFilePath) = "unpin_all" And strMode = "unpin" Then
                    strPinLocation = objShell.ExpandEnvironmentStrings("%APPDATA%") & _
                        "\Microsoft\Internet Explorer\Quick Launch\User Pinned\" & _
                        Replace(strLocation, " ", "") & "\"
                    CreateLocalDirectoryStructure strPinLocation
                    For Each objFile In objFSO.GetFolder(strPinLocation).Files
                        strFullPath = objFile.Path
                        'Set objFile = objFSO.GetFile(objFile.Path)
                        Set objFolder = objShellApp.Namespace(objFile.ParentFolder & "\")
                        Set objFolderItem = objFolder.ParseName(objFile.Name)
                        Set colVerbs = objFolderItem.Verbs
                        For Each objVerb In colVerbs
                            If LCase(Replace(objVerb.name, "&", "")) = strVerb Then
                                objVerb.DoIt
                                WScript.Echo strFullPath & strMessage
                            End If
                        Next
                    Next
                Else
                    If objFSO.FileExists(strFilePath) = True Then
                        Set objFile = objFSO.GetFile(strFilePath)
                        Set objFolder = objShellApp.Namespace(objFile.ParentFolder & "\")
                        Set objFolderItem = objFolder.ParseName(objFile.Name)
                        Set colVerbs = objFolderItem.Verbs
                        blnOptionFound = False
                        For Each objVerb In colVerbs
                            If LCase(Replace(objVerb.name, "&", "")) = strVerb Then
                                objVerb.DoIt
                                blnOptionFound = True
                            End If
                        Next
                        If blnOptionFound = True Then
                            WScript.Echo strFilePath & strMessage
                        Else
                            WScript.Echo "Unable to " & strMode & " " & strFilePath & " from the " & strLocation & ". The verb does not exist."
                        End If
                    Else
                        WScript.Echo "Could not find " & strFilePath
                    End If
                End If
            Next
        End If
    Next
Next

Sub CreateLocalDirectoryStructure(strPath)
	' Check if the path is a local file path
	'WScript.Echo "Argument passed for local creation: " & strPath
	If Mid(strPath, 2, 2) = ":\" Then
		If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)
		arrBits = Split(strPath, "\")
		strSubPath = arrBits(0)
		If UBound(arrBits) > 0 Then
			For intBit = 1 To UBound(arrBits)
				strSubPath = strSubPath & "\" & arrBits(intBit)
				'WScript.Echo strSubPath & " is being checked..."
				If objFSO.FolderExists(strSubPath) = False Then
					objFSO.CreateFolder(strSubPath)
					'WScript.Echo strSubPath & " created."
				Else
					'WScript.Echo strSubPath & " exists."
				End If
			Next
		End If
	Else
		WScript.Echo "A local directory path was not passed to the CreateLocalDirectoryStructure procedure."
	End If
End Sub

Open in new window

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.