Is there a way to add a short cut to the "Pinned" area of the Start Menu in XP through VB?
Printable View
Is there a way to add a short cut to the "Pinned" area of the Start Menu in XP through VB?
You can script it.
EDIT: Or if you want, you can edit the binary string named Favorites in the registry.Code:Set objShell = CreateObject("Shell.Application")
Set theFolder = objShell.Namespace("C:\path\to\application")
Set theApplication = theFolder.ParseName("application_name.exe")
theApplication.InvokeVerb("P&in to Start Menu")
Code:HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\StartPage
I would avoid direct edits of the registry for a number of reasons. Not the least are:Quote:
EDIT: Or if you want, you can edit the binary string named Favorites in the registry.
1) Registry formats are subject to change without notice
2) Edits such as the one shown do not properly maintain ACL's (which is why you should use regedt32.exe rather than regedit on most operating systems where there is a choice)
Thats brilliant!
Is there a way to rename the title once it's pinnned as it just comes up the EXE name on the start menu.
To my knowledge...not without editing the registry. You can create a shortcut placed in the same folder as the executable. And then pin that shortcut to the desktop.
ok thats cool, what about pinning a link to a html page... cant seem to get it to work...
I might be mistaken, but I think only executables can be pinned to the start menu.
hmm I guess for the purpose, I could always make a small EXE that executes the html page externally then closes...Quote:
Originally Posted by PeejAvery
Well, first try creating a shortcut to a webpage and then drag it to the pin area. If it lets you, then we can probably find a solution.
The script posted in this thread doesn't seem to work on Vista.
This script works on both XP and Vista.
A reference to
"Windows script host object model"
You should not always pin executables directly to the start menu, because not all of them will load correctly for some unknown reason.Code:Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function apiGetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Sub Form_Load()
Dim pinned As Boolean
pinned = PinToStartMenu(App.EXEName, True) 'Pins this program to the start menu
If pinned = True Then
MsgBox "Pinned to the start menu"
Else
MsgBox "Not pinned to the start menu"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call PinToStartMenu(App.EXEName, False) 'Unpins this program from the start menu
End Sub
Private Function PinToStartMenu(ByVal fName As String, Optional ByVal pMenu As Boolean = True) As Boolean
On Error Resume Next
Call CreateShortCut(App.Path & "\" & App.EXEName & ".exe", App.Path, App.EXEName)
If pMenu = True Then PinToStartMenu = DoVerb(fName, "P&in to Start Menu")
If pMenu = False Then PinToStartMenu = DoVerb(fName, "Unp&in from Start Menu")
End Function
Private Function CreateShortCut(ByVal filePathOrigin As String, ByVal folderPathDestination As String, ByRef linkName As String) As Boolean
On Error Resume Next
Dim WshShell As Object
Dim oShellLink As Object
Set WshShell = CreateObject("WScript.Shell")
Set oShellLink = WshShell.CreateShortCut(folderPathDestination & "\" & linkName & ".lnk")
oShellLink.TargetPath = filePathOrigin
oShellLink.WindowStyle = 1
oShellLink.Hotkey = ""
oShellLink.Description = ""
oShellLink.WorkingDirectory = sDir
oShellLink.Save
CreateShortCut = True
End Function
Private Function DoVerb(ByVal fName As String, ByVal sVerb As String) As Boolean
On Error Resume Next
Dim objShell As Object
Dim objFolder As Object
Dim objFolderItem As Object
Dim objVerb As Object
Dim objVerbs As Object
Dim osv As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(CurDir)
If objFolder Is Nothing Then GoTo Release
Set objFolderItem = objFolder.ParseName(fName & ".lnk")
If objFolderItem Is Nothing Then GoTo Release
osv = GetOSVersion
If osv = "5.0" Or osv = "5.1" Then
objFolderItem.InvokeVerb (sVerb)
DoVerb = True 'Did it, or at least tried to do it
ElseIf Mid(osv, 1, 1) = "6" Or Mid(osv, 1, 1) = "7" Then
Set objVerbs = objFolderItem.verbs
For Each objVerb In objVerbs
If objVerb.Name = sVerb Then
objVerb.DoIt
DoVerb = True 'Did it, or at least tried to do it
End If
Next
End If
Release:
objShell = Nothing: objFolder = Nothing: objFolderItem = Nothing: objFolderItemVerb = Nothing: objFolderItemVerbs = Nothing
End Function
Private Function GetOSVersion() As String
On Error Resume Next
Dim OSInfo As OSVERSIONINFO
OSInfo.dwOSVersionInfoSize = Len(OSInfo)
Call apiGetVersionEx(OSInfo)
GetOSVersion = CStr(OSInfo.dwMajorVersion) & "." & LTrim(CStr(OSInfo.dwMinorVersion))
GetOSVersion = Trim(GetOSVersion)
End Function
The solution is to make a shortcut to the executable, and then pin that file(.lnk) to the start menu.
You may want to hide the shortcuts somewhere though, in the case the user deletes the shortcut.