Private Sub Command1_Click()
    On Error GoTo Command1_Click
 
    Dim WshShell As Object
    Dim sPath As String
    Dim sEXE As String
    Dim sDatei As String
    Dim sLinkName As String
    Dim sWorkingDir As String
    Dim sComment As String
    Dim sHotKey As String
 
'    SpecialFolders ("AllUsersDesktop")
'    SpecialFolders ("AllUsersStartMenu")
'    SpecialFolders ("AllUsersPrograms")
'    SpecialFolders ("AllUsersStartUp")
'    SpecialFolders ("Desktop")
'    SpecialFolders ("StartMenu")
'    SpecialFolders ("Programs")
'    SpecialFolders ("StartUp")
 
    Set WshShell = CreateObject("WScript.Shell")
    sPath = WshShell.SpecialFolders("StartUp")
    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    Set WshShell = Nothing
 
    'exe- pfad
    sEXE = "c:\Programme\Anwendung.exe"
    'datei-pfad
    sDatei = ""
    ' Name der Verknüpfung
    sLinkName = "Name der Verknüpfung" & ".lnk"
    ' Arbeitsverzeichnis (Ausführen in...)
    sWorkingDir = App.Path
    ' Kommentar (Beschreibung)
    sComment = "Programm-Name"
    ' HotKey
    sHotKey = ""    'pflicht
 
    ' Verknüpfung auf dem Desktop erstellen
    If CreateLink(sEXE, sPath & sLinkName, sDatei, sComment, sWorkingDir, _
      sHotKey) Then
      Call SndPlaySound(pubEXEpfad & "Pfeil.wav", snd_async)
    Else
      MsgBox "Fehler beim Erstellen der Verknüpfung!"
    End If
 
    Exit Sub
Command1_Click:
    MsgBox Err.Number & " " & Err.Description, vbExclamation, "Command1_Click"
End Sub
 
 
' Verknüpfung erstellen
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
 
  ' Fehlerbehandlung, falls WSH-Objekt nicht
  ' verfügbar
  On Error GoTo ErrHandler
  Dim WshShell As Object
  Dim WshLink As Object
 
  ' Verweis auf den Windows Scripting Host erstellen
  Set WshShell = CreateObject("WScript.Shell")
 
  ' Neuen Link Erstellen
  Set WshLink = WshShell.CreateShortcut(sLinkName)
 
  With WshLink
    ' Ziel der Verknüpfung
    .TargetPath = sFile
 
    ' Weitere Eigenschaften...
    .WorkingDirectory = sWorkingDir
    .Arguments = sParameter
    .Description = sComment
    .HotKey = sHotKey
 
    ' Verknüpfung speichern
    .Save
  End With
 
  ' Objekte zerstören
  Set WshLink = Nothing
  Set WshShell = Nothing
 
  CreateLink = True
  On Error GoTo 0
  Exit Function
 
ErrHandler:
  CreateLink = False
End Function