Pin a Shortcut onto the Taskbar or Start Menu from Network-Application

Introduction

This is a VB.NET version for Network-Applications and it works with the German Win7. If you want to use it in another language, you have to change the PinUnpin-Sub.

Using the Code

Make links to the follow Com-Objects in your project:

• 'Microsoft Shell Controls And Automation'
• 'Windows Script Host Object Model'

Imports Shell32
Imports IWshRuntimeLibrary
Public Module LinkHelper

    Public Enum Where
        Startmenue
        Taskbar
    End Enum

    Public Sub PinUnpin(ByVal filePath As String, ByVal pin As Boolean, ByVal Where As Where)

        If Not IO.File.Exists(filePath) Then
            Throw New IO.FileNotFoundException(filePath)
        End If

        ' create an shell object
        Dim shellApplication As Shell = CType(Activator.CreateInstance_
        (Type.GetTypeFromProgID("Shell.Application")), Shell)

        Dim path1 As String = IO.Path.GetDirectoryName(filePath)
        Dim fileName As String = IO.Path.GetFileName(filePath)

        Dim directory As Shell32.Folder = shellApplication.[NameSpace](path1)
        Dim link As FolderItem = directory.ParseName(fileName)

        Dim verbs As Shell32.FolderItemVerbs = link.Verbs()

        For i As Integer = 0 To verbs.Count() - 1
            Dim verbName As String = verbs.Item(i).Name.Replace("&", String.Empty).ToLower()

            If Where = LinkHelper.Where.Taskbar Then
                'If (pin AndAlso verbName.Equals("pin to taskbar")) _
                'OrElse (Not pin AndAlso verbName.Equals("unpin from taskbar")) 'Then
                If (pin AndAlso verbName.Equals("an taskleiste anheften")) _
                OrElse (Not pin AndAlso verbName.Equals("von taskleiste lösen")) Then
                    verbs.Item(i).DoIt()
                    Exit For
                End If
            ElseIf Where = LinkHelper.Where.Startmenue Then
                If (pin AndAlso verbName.Equals("an startmenü anheften")) _
                OrElse (Not pin AndAlso verbName.Equals("vom startmenü lösen")) Then
                    '"an startmenü anheften"
                    verbs.Item(i).DoIt()
                    Exit For
                End If
            End If
        Next i

        shellApplication = Nothing
    End Sub
    ''' <summary>
    ''' Change link-target in .lnk file
    ''' COM reference to 'Microsoft Shell Controls And Automation' needed
    ''' </summary>
    ''' <param name="shortcutFullPath"></param>
    ''' <param name="LinkData"></param>
    Public Sub ChangeLinkTarget(shortcutFullPath As String, LinkData As ILinkData)
        ' Load the shortcut
        Dim shell As New Shell32.Shell()
        Dim folder As Shell32.Folder = shell.[NameSpace]_
        (IO.Path.GetDirectoryName(shortcutFullPath))
        Dim folderItem As Shell32.FolderItem = folder.Items().Item_
        (IO.Path.GetFileName(shortcutFullPath))
        Dim currentLink As Shell32.ShellLinkObject = _
        DirectCast(folderItem.GetLink, Shell32.ShellLinkObject)
        ' Assign the new path here
        With currentLink
            .Path = LinkData.Path
            .Arguments = LinkData.Arguments
            .Description = LinkData.Description
            .Hotkey = LinkData.Hotkey
            .ShowCommand = LinkData.ShowCommand
            .WorkingDirectory = LinkData.WorkingDirectory
            .SetIconLocation(LinkData.IconLocation, 0)
        End With

        ' Save the link to commit the changes
        currentLink.Save()
    End Sub
    Public Interface ILinkData
        Property Name As String
        Property Path As String
        Property Arguments As String
        Property Description As String
        Property Hotkey As Integer
        Property ShowCommand As Integer
        Property WorkingDirectory As String
        Property IconLocation As String
    End Interface
    Public Class LinkData
        Implements ILinkData


        Public Property Arguments As String = "" Implements ILinkData.Arguments

        Public Property Description As String = "" Implements ILinkData.Description

        Public Property Hotkey As Integer = 0 Implements ILinkData.Hotkey

        Public Property IconLocation As String = "" Implements ILinkData.IconLocation

        Public Property Name As String = "" Implements ILinkData.Name

        Public Property Path As String = "" Implements ILinkData.Path

        Public Property ShowCommand As Integer = 0 Implements ILinkData.ShowCommand

        Public Property WorkingDirectory As String = "" Implements ILinkData.WorkingDirectory
    End Class

    Public Function CreateLink(ByVal sFile As String, _
ByVal sLinkName As String, _
Optional ByVal sParameter As String = "", _
Optional ByVal sComment As String = "", _
Optional ByVal sWorkingDir As String = "", _
Optional ByVal sHotKey As String = "") As Boolean

        ' Error_handling if we can't use the WSH-Object 
        On Error GoTo ErrHandler
        Dim WshShell As WshShell
        Dim WshLink As WshShortcut

        ' new Windows Scripting Host Object
        WshShell = CreateObject("WScript.Shell")

        ' create new Link
        WshLink = WshShell.CreateShortcut(sLinkName)

        With WshLink
            ' Target of the link
            .TargetPath = sFile

            ' more...
            .WorkingDirectory = sWorkingDir
            .Arguments = sParameter
            .Description = sComment
            .Hotkey = sHotKey
            .IconLocation = sFile & ",0"
            ' save link
            .Save()
        End With

        ' destroy all objects
        WshLink = Nothing
        WshShell = Nothing

        CreateLink = True
        On Error GoTo 0
        Exit Function

ErrHandler:
        MsgBox(Err.Description)
        CreateLink = False
    End Function
    Public Sub PinApplicationToTaskBar(ByVal Where As Where, ByRef LinkData As ILinkData)
        Dim HasAlreadyBeenPinnedShortCut As String, TempShortcut As String
        Dim lnk As WshShortcut
        Dim WshShell As WshShell
        Try

            ' create new Windows Scripting Host Object
            WshShell = CreateObject("WScript.Shell")

            'Create a temp location for the short-cut to exist
            Dim TempShortcutLocation As String = Environment.GetFolderPath_
            (Environment.SpecialFolder.DesktopDirectory)
            'Where is it being pinned?  Determine the location where the pinned item will reside
            If Where = LinkHelper.Where.Startmenue Then ' pinned to start menu
                HasAlreadyBeenPinnedShortCut = Environment.GetFolderPath_
                (Environment.SpecialFolder.ApplicationData) & _
                "\Microsoft\Internet Explorer\Quick Launch\User Pinned\StartMenu"
            Else
                HasAlreadyBeenPinnedShortCut = Environment.GetFolderPath_
                (Environment.SpecialFolder.ApplicationData) & _
                "\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar"
            End If
            'Temporary location for the application short-cut
            TempShortcut = TempShortcutLocation & "\" & _
            LinkData.Name & ".lnk"
            'Possible location of a pinned item
            HasAlreadyBeenPinnedShortCut = HasAlreadyBeenPinnedShortCut _
            & "\" & LinkData.Name & ".lnk"

            'If this already exists, than exit this procedure. 
            'The application has already been pinned.
            If (IO.File.Exists(HasAlreadyBeenPinnedShortCut)) Then
                'MsgBox(HasAlreadyBeenPinnedShortCut & " Already Pinned")
                Exit Sub
            End If
            Dim TempExeName As String = TempShortcutLocation _
            & "\" & LinkData.Name & "_Temp.exe"
            IO.File.Copy(LinkData.Path, TempExeName)

            'Create a short-cut using the shell
            lnk = WshShell.CreateShortcut(TempShortcut)
            lnk.TargetPath = TempExeName ' Full application path and name
            lnk.Arguments = ""
            lnk.Description = LinkData.Name 'The name that appears on the start menu.
            lnk.Save()

            If IO.File.Exists(TempShortcut) Then
                Call PinUnpin(TempShortcut, True, Where)

                If (IO.File.Exists(HasAlreadyBeenPinnedShortCut)) Then
                    ChangeLinkTarget(HasAlreadyBeenPinnedShortCut, LinkData)
                End If

                'Delete the temporary short-cut used to pin the application
                IO.File.Delete(TempShortcut)
            End If
            IO.File.Delete(TempExeName)
        Catch ex As Exception
            MsgBox(ex.Message)
            Err.Clear()
        Finally
            'clean up
            WshShell = Nothing
        End Try
    End Sub
End Module

I use it in my WPF application like:

Dim sFile As String = System.Diagnostics.Process.GetCurrentProcess()._
MainModule.FileName 'Application.Path & "\" & App.EXEName & ".exe"

    Dim LinkData As HelperModule.LinkHelper.ILinkData = New HelperModule.LinkHelper.LinkData
    With LinkData
        .WorkingDirectory = System.AppDomain.CurrentDomain.BaseDirectory
        .Path = sFile
        .Name = Application.Current.MainWindow.GetType().Assembly.GetName.Name
        .IconLocation = sFile
    End With

    HelperModule.LinkHelper.PinApplicationToTaskBar_
    (HelperModule.LinkHelper.Where.Taskbar, LinkData)

History

• 20141209: Initial post