Hola de nuevo, Leo.
Mira, pues para crear un acceso directo en Windows XP, usa el código siguiente.
Pega esto en un módulo:
'_________________________________________________________
'CÓDIGO FUENTE DEL MÓDULO
'_________________________________________________________
'Esta función, a partir de un nombre de archivo, directorio de destinación y
'una variable Opcional que contiene los Argumentos, crea un Acceso Directo
'del archivo introducido en primer lugar.
Public 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
'_________________________________________________________
'CÓDIGO FUENTE DEL MÓDULO
'_________________________________________________________
Y, para testear el código, pega lo siguiente en el evento Load del Formulario principal del proyecto:
'_________________________________________________________
'CÓDIGO FUENTE DEL FORMULARIO
'_________________________________________________________
Dim numError As Long 'Almacena el número de error
numError = CreateShortCut("C:\ruta.exe", "Desktop") 'Llamada a la función
'dando como destinación
'el Escritorio
'ESPECIFICACIONES
'--------------------------------------------------------
'Puede ser cualquier tipo de archivo.
'Aquí se presentan las 3 destinaciones más usuales:
'Escritorio -> "Desktop"
'Inicio-Programas -> "Programs"
'Mis Documentos -> "MyDocuments"
'Inicio -> "StartMenu"
'--------------------------------------------------------
If numError = -1 Then
MsgBox "Se ha creado el acceso directo" 'Mensaje indicando Acceso directo creado
Else
MsgBox "Error: " & numError & vbCrLf & vbCrLf _
& "No se pudo completar la operación" 'Error al crear Acceso directo
End If
'_________________________________________________________
'CÓDIGO FUENTE DEL FORMULARIO
'_________________________________________________________
Espero que esto te ayude.
Hasta otra,
Zoto
