Hola, Jorge.
Hace tiempo escribí un código para realizar la operación que tu solicitas.
Aquí lo he recuperado y te lo he comentado exhaustivamente.
'====================================
'CODIGO MODULO
'====================================
'Esta función es la que se encarga de crear el acceso directo.
'Toma como parámetros:
'-FileName - el nombre completo del ejecutable (por ejemplo: "C:\Programas\programa.exe")
'-Destination - se trata de un String que determina el path o ruta donde crear el acceso directo. Hay algunos ya predeterminados, como:
'"Desktop" - lo crea en el Escritorio
'"Programs"- lo crea en Inicio > Programas
'"MyDocuments" - lo crea en Mis Documentos
'"StartMenu"- lo crea en el Menú Inicio
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
'Aquí puedes indicar el icono
WShortCut.IconLocation = FileName & ", 0"
WShortCut.WorkingDirectory = Left(FileName, Len(FileName) - Len(Dir(FileName)))
'Aquí se toman 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
'====================================
'CODIGO FORMULARIO
'====================================
'En tu caso deseas crear un acceso directo en el escritorio solo la primera vez que el programa se ejecute, por lo tanto deberás guardar un valor de referencia que te indique si el programa ha sido ya ejecutado.
'Para hacerlo de manera sencilla, yo, en mi ejemplo, voy a utilizar las funciones GetSetting y SaveSetting.
'Para comprobar si la aplicación se ha ejecutado antes o es la primera vez que lo hace utiliza esta función:
Private Sub Form_Load()
If IsFirstTime = True Then 'Si es la primera vez que se ejecuta el programa
Dim numError As Long 'Variable que contiene el valor de retorno de la función encargada de crear el acceso directo (CreateShortCut)
numError = CreateShortCut("C:\Programas\programa.exe", "Desktop") 'Se crea el acceso directo:
'El primer parámetro es el nombre del programa, en este ejemplo: "C:\Programas\programa.exe"
'El segundo es el directorio donde crear el acceso directo.
'Además de tener la posibilidad de poner el tuyo propio, por ejemplo, "C:\", hay algunos
'ya predeterminados (te los he escrito en la definición de la función CreateShortCut)
'En tu caso, quieres crear el acceso directo en el escritorio, así que debes escribir "Desktop",
'como en el ejemplo.
If numError = -1 Then 'Acceso directo creado
MsgBox "El acceso directo se ha creado satisfactoriamente.", vbInformation + vbOKOnly, "Acceso directo creado"
Else 'Error al crear el acceso directo
MsgBox "Ha ocurrido un error al crear el acceso directo." & vbCrLf & "Número de error: " & numError & vbCrLf & vbCrLf _
& "No se pudo completar la operación."
End If
End Function
Public Function IsFirstTime() As Boolean
Dim Value As String 'Se declara una variable que contendrá el valor obtenido
Value = GetSetting(App.EXEName, "Settings", "Executed") 'A la variable Value
'se le da el valor obtenido después de consultar el valor del registro
If Value = "" Then 'Si el valor es nulo, es decir, no existe, quiere decir que el programa
'no se había ejecutado antes, es decir, es la primera vez que se ejecuta.
SaveSetting App.EXEName, "Settings", "Executed", "Yes" 'Se guarda el valor para indicar
'que ahora si se ha ejecutado el programa
IsFirstTime = True 'La función devuelve True, puesto que es la primera vez que se ha ejecutado el programa
End If
'Como el valor por defecto de una variable Booleana es False, si el valor no es nulo
'no se entrará en la condición y no se cambiará el valor de la variable IsFirstTime,
'que seguirá siendo False, indicando que la aplicación ya fue ejecutada antes,
'es decir, NO es la primera vez que se ha ejecutado la aplicación
End Function
'====================================
'CODIGO MODULO
'====================================
'Esta función es la que se encarga de crear el acceso directo.
'Toma como parámetros:
'-FileName - el nombre completo del ejecutable (por ejemplo: "C:\Programas\programa.exe")
'-Destination - se trata de un String que determina el path o ruta donde crear el acceso directo. Hay algunos ya predeterminados, como:
'"Desktop" - lo crea en el Escritorio
'"Programs"- lo crea en Inicio > Programas
'"MyDocuments" - lo crea en Mis Documentos
'"StartMenu"- lo crea en el Menú Inicio
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
'Aquí puedes indicar el icono
WShortCut.IconLocation = FileName & ", 0"
WShortCut.WorkingDirectory = Left(FileName, Len(FileName) - Len(Dir(FileName)))
'Aquí se toman 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
'====================================
'CODIGO FORMULARIO
'====================================
'En tu caso deseas crear un acceso directo en el escritorio solo la primera vez que el programa se ejecute, por lo tanto deberás guardar un valor de referencia que te indique si el programa ha sido ya ejecutado.
'Para hacerlo de manera sencilla, yo, en mi ejemplo, voy a utilizar las funciones GetSetting y SaveSetting.
'Para comprobar si la aplicación se ha ejecutado antes o es la primera vez que lo hace utiliza esta función:
Private Sub Form_Load()
If IsFirstTime = True Then 'Si es la primera vez que se ejecuta el programa
Dim numError As Long 'Variable que contiene el valor de retorno de la función encargada de crear el acceso directo (CreateShortCut)
numError = CreateShortCut("C:\Programas\programa.exe", "Desktop") 'Se crea el acceso directo:
'El primer parámetro es el nombre del programa, en este ejemplo: "C:\Programas\programa.exe"
'El segundo es el directorio donde crear el acceso directo.
'Además de tener la posibilidad de poner el tuyo propio, por ejemplo, "C:\", hay algunos
'ya predeterminados (te los he escrito en la definición de la función CreateShortCut)
'En tu caso, quieres crear el acceso directo en el escritorio, así que debes escribir "Desktop",
'como en el ejemplo.
If numError = -1 Then 'Acceso directo creado
MsgBox "El acceso directo se ha creado satisfactoriamente.", vbInformation + vbOKOnly, "Acceso directo creado"
Else 'Error al crear el acceso directo
MsgBox "Ha ocurrido un error al crear el acceso directo." & vbCrLf & "Número de error: " & numError & vbCrLf & vbCrLf _
& "No se pudo completar la operación."
End If
End If
End Sub
Public Function IsFirstTime() As Boolean
Dim Value As String 'Se declara una variable que contendrá el valor obtenido
Value = GetSetting(App.EXEName, "Settings", "Executed") 'A la variable Value
'se le da el valor obtenido después de consultar el valor del registro
If Value = "" Then 'Si el valor es nulo, es decir, no existe, quiere decir que el programa
'no se había ejecutado antes, es decir, es la primera vez que se ejecuta.
SaveSetting App.EXEName, "Settings", "Executed", "Yes" 'Se guarda el valor para indicar
'que ahora si se ha ejecutado el programa
IsFirstTime = True 'La función devuelve True, puesto que es la primera vez que se ha ejecutado el programa
End If
'Como el valor por defecto de una variable Booleana es False, si el valor no es nulo
'no se entrará en la condición y no se cambiará el valor de la variable IsFirstTime,
'que seguirá siendo False, indicando que la aplicación ya fue ejecutada antes,
'es decir, NO es la primera vez que se ha ejecutado la aplicación
End Function
'==================================
Bien, aquí termina el código.
Espero que te funcione.
Si te da algún error o tienes alguna duda o problema con él coméntamelo.
Hasta otra,
Zoto
