En un modulo pones:
Function CreateShortCut( _
FileName As String, _
Destination As Variant, _
Optional Args As String) As Long
Dim WScript As Object
Dim WShortCut As Object
Dim ShortCutPath As String
On Error GoTo CreateShortCut_Error
If Len(Dir(FileName)) = 0 Then Err.Raise 52
Set WScript = CreateObject("WScript.Shell")
ShortCutPath = WScript.SpecialFolders(Destination)
If Len(ShortCutPath) = 0 Then
ShortCutPath = Destination
If Len(Dir(ShortCutPath, vbDirectory)) = 0 Then
Err.Raise 52
End If
End If
Set WShortCut = WScript.CreateShortCut _
(ShortCutPath & "\" & Dir(FileName) & ".lnk")
WShortCut.TargetPath = FileName
' Aqui puedes indicar el icono
WShortCut.IconLocation = FileName & ", 0"
WShortCut.WorkingDirectory = Left(FileName, _
Len(FileName) - Len(Dir(FileName)))
' indicas los argumentos
WShortCut.Arguments = Args
WShortCut.Save
CreateShortCut = -1
exit_CreateShortCut:
Set WShortCut = Nothing
Set WScript = Nothing
On Error GoTo 0
Exit Function
CreateShortCut_Error:
CreateShortCut = Err.Number
Resume exit_CreateShortCut
End Function
y en el form:
Dim numError As Long
numError = CreateShortCut("C:\ruta.exe", "Desktop")
'Puede ser cualquier tipo de archivo
'si lo vas a hacer en Inicio->Programas pones "Programs"
'mis documentos "MyDocuments"
'menu inicio "StartMenu"
If numError = -1 Then
MsgBox "Se ha creado el acceso directo"
Else
MsgBox "Error: " & numError & vbCrLf & vbCrLf _
& "No se pudo completar la operación"
End If
espero te sirva...
