Function zur Erstellung eines ShortCuts

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

Function CreateShortCut(ByVal ShortCutTarget As String, _
                        ByVal ShortcutKey As String, _
                        ByVal ShortCutDescription As String) As Boolean

    Try
            ' Das Shell-Objekt des Windows Script Hosts erstellen.
            Dim WSHShell As Object = CreateObject("WScript.Shell")
            Dim DesktopDir As String = CType(WSHShell.SpecialFolders.Item("Desktop"), String)
            Dim Shortcut As Object

            'Verknüpfungen verfügen über die Erweiterung *.lnk (Link).
            'Diese muss mit angegeben werden
            Shortcut = WSHShell.CreateShortcut(DesktopDir & "\VS-SUPPORT.lnk")

            'es werden nun noch die Eigenschaften des Links festgelegt.
            '    Shortcut.TargetPath        = wohin verweist der ShortCut
            '    Shortcut.HotKey            = tastenkombination zum Aufruf des Links
            '    Shortcut.Description       = Beschreibung
            '    Shortcut.WorkingDirectory  = Arbeitsverzeichnis

            'Anlegen des ShortCut

            Shortcut.TargetPath = ShortCutTarget
            Shortcut.WindowStyle = 2
            Shortcut.Hotkey = ShortcutKey
            Shortcut.Description = ShortCutDescription
            Shortcut.WorkingDirectory = DesktopDir

            'Ein Icon zuweisen.
            'Entweder aus der Anwendung, aus einer Exe oder Dll Datei
            'Achtung:
            'Es wird mit 0 mit dem Zählen angefangen

            Shortcut.IconLocation = "explorer.exe, 0"

            ' Verknüpfungsdatei speichern.
            Shortcut.Save()

            MessageBox.Show("Der ShortCut wurde auf dem Desktop erstellt", "", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Return True
     Catch ex As Exception
         Return False
         MessageBox.Show("Der ShortCut auf dem Desktop konnte nicht erstellt werden. " & vbCrLf & _
                         ex.Message, "Fehler", MessageBoxButtons.OK, MessageBoxIcon.Information)

     End Try

End Function

'Aufruf

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        CreateShortCut("http://www.vs-support.com", "CTRL+SHIFT+S", "VS-SUPPORT")
End Sub