Pin to Start Menu

[an0key]

Is there a way to add a short cut to the "Pinned" area of the Start Menu in XP through VB?

[PeejAvery]

You can script it.

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")

EDIT: Or if you want, you can edit the binary string named Favorites in the registry.

HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\StartPage

[TheCPUWizard]

EDIT: Or if you want, you can edit the binary string named Favorites in the registry.

I would avoid direct edits of the registry for a number of reasons. Not the least are:

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)

[an0key]

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.

[PeejAvery]

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.

[an0key]

ok thats cool, what about pinning a link to a html page... cant seem to get it to work...

[PeejAvery]

I might be mistaken, but I think only executables can be pinned to the start menu.

[an0key]

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...

[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.

[TT(n)]

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"

    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

You should not always pin executables directly to the start menu, because not all of them will load correctly for some unknown reason.
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.