on error resume next 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("C:\Pinned_Shortcuts") Set objFolderItem = objFolder.ParseName("Notepad.lnk") Set colVerbs = objFolderItem.Verbs For Each objVerb in colVerbs If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt Next 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 Set objFolderItem = objFolder.ParseName("MSInfo32.lnk") Set colVerbs = objFolderItem.Verbs For Each objVerb in colVerbs If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt Next Set objFolderItem = objFolder.ParseName("Write.lnk") Set colVerbs = objFolderItem.Verbs For Each objVerb in colVerbs If Replace(objVerb.name, "&", "") = "Pin to Start Menu" Then objVerb.DoIt Next