Private Sub Command3_Click()
    Call CreateShortcut("C:\Dokumente und Einstellungen\All" & _
      "Users\Desktop\MyApp.lnk", App.Path + "\MyApp.exe", App.Path + _
      "\Icons\MyIcon.ico", , "MyApp")
End Sub
 
Public Function CreateShortcut(ByVal sLinkFile As String, ByVal sTargetFile As _
  String, Optional sICOFile As String, Optional ByVal sArguments As String, _
  Optional ByVal sDescription As String, Optional ByVal sWorkingDir As String)
    Dim oShell As New Shell32.Shell
    Dim oFolder As Shell32.Folder
    Dim oLink As Shell32.ShellLinkObject
    Dim sPath As String
    Dim sFile As String
    Dim F As Integer
 
    On Error Resume Next
 
'Ordner und Dateiname extrahieren
    sPath = Left$(sLinkFile, InStrRev(sLinkFile, "\") - 1)
    sFile = Mid$(sLinkFile, InStrRev(sLinkFile, "\") + 1)
 
'Link-Datei mit 0 Bytes erstellen, da die Link-Datei bereits voranden sein muss
    F = FreeFile
    Open sLinkFile For Output As #F
    Close #F
 
    Set oFolder = oShell.NameSpace(sPath)
    Set oLink = oFolder.Items.Item(sFile).GetLink
 
'Eigenschaften der Verknüpfung
    With oLink
        If sICOFile <> "" Then .SetIconLocation sICOFile, 0
        If sArguments <> "" Then .Arguments = sArguments
        If sDescription <> "" Then .Description = sDescription
        If sWorkingDir <> "" Then .WorkingDirectory = sWorkingDir
        .Path = sTargetFile
'Verknüpfung speichern
        .Save
    End With
 
'Objekte zerstören
    Set oLink = Nothing
    Set oFolder = Nothing
    Set oShell = Nothing
End Function

Gru? Michi aus Hannover

1 + 1 = 3 f?r hinreichend gro?e 1