Pin to W7 start menu

[Briandr]

Hi,

I found this script for pinning items to the Win 7 start menu for all users.

Const CSIDL_COMMON_PROGRAMS = &H17
Const CSIDL_PROGRAMS = &H2
Set objShell = CreateObject("Shell.Application")
Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path
Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Accessories")
Set objFolderItem = objFolder.ParseName("Calculator.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt
Next

What I am wondering is how do I tweak this if the item I wish to pin is not in a folder off the 'Programs' menu?

Do I simply change this?

Set objFolder = objShell.Namespace(strAllUsersProgramsPath)

I think I messed around with that and it was giving me an error. Also, what about adding additional pins?

Thanks

 

[Briandr]

Hi,

So I am hoping someone might take a moment out of their day to help out. I modified the above script to be this:

Const CSIDL_COMMON_PROGRAMS = &H17
Const CSIDL_PROGRAMS = &H2

Set objShell = CreateObject("Shell.Application")
Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path
Set objFolder = objShell.Namespace(strAllUsersProgramsPath)
Set objFolderItem = objFolder.ParseName("TeamViewer 7 Host.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt

Next

Set objShell = CreateObject("Shell.Application")
Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path
Set objFolder = objShell.Namespace(strAllUsersProgramsPath)
Set objFolderItem = objFolder.ParseName("IP Address.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt

Next

I have 12 systems built with a Hardware Independent Image (drivers get injected last) and on half these systems (All Win 7 64-bit) the script works. The other half report a error on line 9 about objFolderItem required.

Any ideas?

Help appreciated.

 

[guitarzan]

On the affected machines, browse to wherever strAllUsersProgramsPath resolves to and see if "TeamViewer 7 Host.lnk" exists there.

Or directly before line 9 try inserting:

Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(strAllUsersProgramsPath & "\TeamViewer 7 Host.lnk") Then
   Wscript.echo strAllUsersProgramsPath & "\TeamViewer 7 Host.lnk not found."
End If

 

[Briandr]

Thanks for the tip. It helped.

 

[Briandr]

If I can ask for assistance one more time on this. The script works great, but it needs to pin these items to the Windows 7 start menu for all users. It seems like it only works for the current user.

Const CSIDL_COMMON_PROGRAMS = &H17
Const CSIDL_PROGRAMS = &H2

Set objShell = CreateObject("Shell.Application")
Set objDefaultUserProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strDefaultUserProgramsPath = objDefaultUserProgramsFolder.Self.Path
Set objFolder = objShell.Namespace(strDefaultUserProgramsPath)
Set objFolderItem = objFolder.ParseName("TeamViewer 7 Host.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt

Next

Set objShell = CreateObject("Shell.Application")
Set objDefaultUserProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strDefaultUserProgramsPath = objDefaultUserProgramsFolder.Self.Path
Set objFolder = objShell.Namespace(strDefaultUserProgramsPath)
Set objFolderItem = objFolder.ParseName("IP Address.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt

Next


This apparently is not coded right and it errors out line 9, Character 1, Object required objFolderItem

Ideas?

Thank you.

 

[Briandr]

Hi,

Well I kinda of got what I am after, but now in addition to pinning I need to unpin from start menu. The code to pin works great (no errors), but I can not unpin IE

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 objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path
Set objFolder = objShell.Namespace(strAllUsersProgramsPath)
Set objFolderItem = objFolder.ParseName("TeamViewer 7 Host.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt

Next

Set objShell = CreateObject("Shell.Application")
Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path
Set objFolder = objShell.Namespace(strAllUsersProgramsPath)
Set objFolderItem = objFolder.ParseName("IP Address.lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt

Next

Set objShell = CreateObject("Shell.Application")
Set objCurrentUserStartFolder = objShell.NameSpace (CSIDL_STARTMENU)
strCurrentUserStartFolderPath = objCurrentUserStartFolder.Self.Path
Set objFolder = objShell.Namespace(strCurrentUserStartFolderPath & "\Programs")
Set objFolderItem = objFolder.ParseName("Internet Explorer (64-bit).lnk")
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
If Replace(objVerb.name, "&", "") = "Unpin from Start Menu" Then objVerb.DoIt

Next

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

Help appreciated. Thanks.

 

[GrimR]

C:\ProgramData\Microsoft\Windows\Start Menu\Programs
and
C:\Users\All Users\Microsoft\Windows\Start Menu\Programs

are the same place

Check

Const CSIDL_COMMON_PROGRAMS = &H17
Const CSIDL_PROGRAMS = &H2

Set objShell = CreateObject("Shell.Application")
Set objShell = Wscript.CreateObject("Wscript.Shell")

Set objDefaultUserProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
	strDefaultUserProgramsPath = objDefaultUserProgramsFolder.Self.Path

	wscript.echo strDefaultUserProgramsPath

Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
	strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path
	
	wscript.echo strAllUsersProgramsPath
	
	
   strPath = objShell.SpecialFolders("AllUsersStartMenu")
   wscript.echo strPath & "\Programs"

MCITP:EA/SA, MCSE, MCSA, MCDBA, MCTS, MCP+I, MCP