Private Sub cmd2_Click()
  Dim objWSHShell As Object
  Dim objWSHShortcut As Object
  Dim userN As String
  Dim sIconLocation As String
  Set objWSHShell = CreateObject("WScript.Shell")
  userN = Application.UserName
  Set objWSHShortcut = objWSHShell.CreateShortcut _
  ("C:\Dokumente und Einstellungen\" & userN & "\Desktop\Test##J-Berichte.lnk") _
  'Verknüpfungsnamen
  ' Symbol (Icon-Datei)
  If IconLocation = Empty Then
    sIconLocation = TargetPath
  Else
    sIconLocation = IconLocation
  End If
  objWSHShortcut.TargetPath = "J:\Berichte" 'Ziel-Ordner
'################
  objWSHShortcut.IconLocation = "C:\Windows\system32\SHELL32.dll, 22" 'Die Lupe
'################
  objWSHShortcut.Description = "Ort: J:\Berichte" 'Wie Control-Tiptext
  objWSHShortcut.WorkingDirectory = ""
  objWSHShortcut.WindowStyle = 1  'WshNormalFocus
  objWSHShortcut.Save
  Set objWSHShortcut = Nothing
  Set objWSHShell = Nothing
End Sub