Scripting

Gidday Moray,

Yep, we've done it with some custom vb code and using active setup for the profile as this is a profile registry entry setting. We used it to pin Add New Programs to the Start Menu rather than Control Panel -> Add and Remove Programs ->Add New Programs.

You might want to modify it to your requirements:

Set objShell = CreateObject("Shell.Application")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim strFileName, verbs, strProfile

strProfile = "C:\Documents and Settings\All Users"
Call FindFileName

Set objFolder = objShell.Namespace(strProfile & "\Start Menu\Network Applications")
Set objFolderItem = objFolder.ParseName(strFileName)
Set colVerbs = objFolderItem.Verbs

'find options
For Each objVerb in colVerbs
verbs = verbs & vbcrlf & objVerb
Next

'msgbox verbs

If (Instr (session.property("MaintenanceMode"), "Remove") = 0) Then
Call PinToStart

ElseIf (Instr (session.property("MaintenanceMode"), "Remove") <> 0) Then
Call RemoveFromStart
End If


Sub RemoveFromStart

If InStr(verbs, "Unp&in from Start menu") Then
'unpin from start menu
objFolderItem.InvokeVerb("Unp&in from Start menu")
End If

If oFSO.FileExists(strProfile & "\Start Menu\Add New Programs.lnk") Then
oFSO.DeleteFile strProfile & "\Start Menu\Add New Programs.lnk"
End If
End Sub

Sub PinToStart

If InStr(verbs, "P&in to") Then
'pin to start menu
objFolderItem.InvokeVerb("P&in to Start menu")
ElseIf (InStr(verbs, "P&in to") = 0) AND (InStr(verbs, "Unp&in") = 0) Then
oFSO.CopyFile strProfile & "\Start Menu\Network Applications\" & strFileName, strProfile & "\Start Menu\Add New Programs.lnk", True
ElseIf InStr(verbs, "p&in") Then
If oFSO.FileExists(strProfile & "\Start Menu\" & strFileName) Then
oFSO.DeleteFile(strProfile & "\Start Menu\" & strFileName)
End If
End If

End Sub





'--------------------------

Sub FindFileName
If oFSO.FileExists(strProfile & "\Start Menu\Network Applications\Add New Programs.lnk") Then
strFileName = "Add New Programs.lnk"
ElseIf oFSO.FileExists(strProfile & "\Start Menu\Network Applications\_Add New Programs.lnk") Then
strFileName = "_Add New Programs.lnk"
End If
End Sub

Hope this helps,

Cheers
Wayne

Thanks for your quick response Wayne.

you mentioned it is a profile registry setting, do you know the reg keys so I can manipulate them directly.

I tried your code, and couldn't get it to work. it is a bit beyond my vbs skills

cheers
Moray

Hey Moray,

No probs; try these keys:

[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Start­Page]
FavoritesResolve [REG_BINARY]
Favorites [REG_BINARY]
FavoritesChanges [REG_DWORD]

Here is the MS site for the script info.
Pin to Start Menu

I didn't create the supplied script, it has been a work in progress from various people here at work. The last guy to work on it is OS at the moment, so I can't check with him. I know it works; though, there has been a few hurdles; mainly to get it to create the link for each profile that logs into the box. When I get the chance I'll do a bit more digging.

Cheers
Wayne

Wayne,

thanks heaps mate, the scripting guys link is exactly what i needed.

cheers
Moray

here is a quick script to pin and unpin items

Option Explicit
On Error Resume next

Dim intPos
Dim objShell, objFolder, objFolderItem

intPos = InStrRev(Wscript.Arguments(0),"\")

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(left(Wscript.Arguments(0),intPos))
Set objFolderItem = objFolder.ParseName(right(Wscript.Arguments(0),len(Wscript.Arguments(0))-intPos))

If wscript.arguments.count > 1 Then
If ucase(Wscript.Arguments(1)) = "U" Then
objFolderItem.InvokeVerb("Unp&in from Start Menu")
wscript.quit
End If
End If

objFolderItem.InvokeVerb("P&in to Start Menu")

Hi,

The "Scripting Guy" approach works, but only with .exe files.
When I tailor it for .LNK files, it returns the following error:

---
Windows Script Host

Script: D:\Dev\Pin.vbs
Line: 4
Char:1
Object Required: 'AppFolderItem'
Code: 800A01A8
Source Microsoft VBScript runtime error
---

Here's the infamous script:

---
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace("C:\")
Set objFolderItem = objFolder.ParseName("test.lnk")
objFolderItem.InvokeVerb("P&in to Start Menu")
---

PLEASE HELP!!!
It has to be an Id10t error

Hi
I have an issue with unpinning the shortcut from the Start Menu. When I right click on the shortcut and select the option "REmove from this list", the shortcut gets removed manually.

But when i try to use the following script to remove the shortcut it does not work.
Shortcut name in Start menu: Sap Logon Pad.lnk

Script Used:
************************************************************
dim objShell,filesystem,objFolder,objFolderItem, colVerbs
dim objVerb
Set objShell = CreateObject("Shell.Application")
set filesystem = CreateObject("scripting.Filesystemobject")
Set objFolder = objShell.Namespace(filesystem.GetParentFolderName("C:\Program Files\SAP\SapSetup\setup\SAL\saplgpad.s8l"))
Set objFolderItem = objFolder.ParseName(filesystem.GetFileName("C:\Program Files\SAP\SapSetup\setup\SAL\saplgpad.s8l"))
Set colVerbs = objFolderItem.Verbs
For Each objVerb in colVerbs
msgbox objVerb
If Replace(objVerb.name, "&", "") = "UnPin from Start Menu" Then objVerb.DoIt
Next

*****************************************************************
Please suggest if there is any other option to resolve this issue using VB script or batch script or some commands.