Argumentos

Argumento	Descripción
FileName	Requerido. La ruta completa del archivo del cual se va a crear el acceso directo
Destination	Requerido. Una de las carpetas especiales de Windows (ver cuadro Valores carpetas especiales), o cualquier otra carpeta con ruta válida.
Args	Opcional. Una cadena conteniendo los posibles argumentos que se le quieran pasar al abrir el archivo a través del acceso directo
LinkName	Opcional. Una cadena que contendrá el nombre del acceso directo. Si este argumento no se especifica, el nombre del acceso directo será el que tenga el archivo que aparezca en el argumento FileName.
IconPath	Opcional. Una cadena que contendrá la ruta y nombre del archivo de icono asociado al acceso directo. Si se omite este argumento, la función intentará asignar el icono por defecto para ese tipo de archivo. Si el fichero es un fichero MDB o MDE, el icono por defecto será el icono que se haya establecido en la propiedad de inicio "Icono de la aplicación" o AppIcon en VBA, o, en caso de no existir, el que Access tenga establecido por defecto.

Valores carpetas especiales

Valor	Descripción
AllUsersDesktop	Carpeta C:\Documents and Settings\All Users\Escritorio
AllUsersStartMenu	Carpeta C:\Documents and Settings\All Users\Menú Inicio
AllUsersPrograms	Carpeta C:\Documents and Settings\All Users\Menú Inicio\Programa
AllUsersStartup	Carpeta C:\Documents and Settings\All Users\Menú Inicio\Programas\Inicio
Desktop	Carpeta Escritorio de Windows
Favorites	Carpeta Favoritos de Internet
Fonts	Carpeta Fuentes de Windows
MyDocuments	Carpeta Mis documentos
NetHood	Carpeta Mis sitios de red
PrintHood	Carpeta Impresoras y faxes del Panel de control
Programs	Carpeta Programas del Menú Inicio
StartMenu	Carpeta Menú Inicio
Startup	Carpeta Menú Inicio\Programas\Inicio
Templates	Carpeta Plantillas

' esta llamada crearía un acceso directo a una base de datos
' en el escritorio de Windows con el nombre "Acceso a Bd1.mdb"
' y con el fichero de icono situado en "C:\MiIcono.ico" como icono asociado
Dim numError As Long
    
    numError = CreateShortCut("C:\Bd1.mdb", "Desktop", , "Acceso a Bd1.mdb", "C:\MiIcono.ico")
    If numError = -1 Then
        MsgBox "Se ha creado un acceso directo a Bd1.mdb en el escritorio"
    Else
        MsgBox "Error: " & numError & vbCrLf & vbCrLf _
        & "No se pudo completar la operación"
    End If

Dim AccessDir As String
Dim Arguments As String
    
    ' construímos una cadena con la ruta completa de Access
    AccessDir = SysCmd(acSysCmdAccessDir) & "msaccess.exe"
    ' cadena de los argumentos del acceso directo
    Arguments = "C:\Bd1.mdb /user Pepe /WRKGRP C:\usuarios.mdw"
    ' llamamos a nuestra función
    CreateShortCut AccessDir, "Desktop", Arguments

'---------------------------------------------------------
'
' CreateShortCut
'
' Código escrito originalmente por Juan M Afán de Ribera.
' Estás autorizado a utilizarlo dentro de una aplicación
' siempre que esta nota de autor permanezca inalterada.
' En el caso de querer publicarlo en una página Web,
' por favor, contactar con el autor en
'
'     accessvbafaq@ya.com
'
' Este código se brinda por cortesía de
' Juan M. Afán de Ribera
'
Function CreateShortCut( _
         FileName As String, _
         Destination As Variant, _
         Optional Args As String, _
         Optional LinkName As String, _
         Optional IconPath As String) As Long

Dim WScript As Object    'New WshShell
Dim WShortCut As Object    'WshShortcut
Dim ShortCutPath As String

    On Error GoTo CreateShortCut_Error

    ' si el archivo no existe lanzamos un error
    ' de ruta de archivo incorrecta
    If Len(Dir(FileName)) = 0 Then Err.Raise 52
    ' creamos un nuevo objeto Shell
    Set WScript = CreateObject("WScript.Shell")
    ' obtenemos la ruta del destino del acceso directo
    ShortCutPath = WScript.SpecialFolders(Destination)
    ' si no es una carpeta especial
    If Len(ShortCutPath) = 0 Then
        ' o no es una carpeta válida
        ShortCutPath = Destination
        If Len(Dir(ShortCutPath, vbDirectory)) = 0 Then
            ' lanzamos el error 52, ruta de archivo incorrecta
            Err.Raise 52
        End If
    End If
    ' creamos el acceso directo al archivo indicado
    Set WShortCut = WScript.CreateShortCut _
                    (ShortCutPath & "\" & Dir(FileName) & ".lnk")
    ' indicamos la ruta del archivo
    WShortCut.TargetPath = FileName
    ' si se ha indicado el icono para el acceso directo
    If Len(Dir(IconPath)) > 0 Then
        WShortCut.IconLocation = IconPath & ", 0"
    Else
    ' sino, indicamos el icono por defecto
        WShortCut.IconLocation = FileName & ", 0"
    End If
    'indicamos el directorio de trabajo en la carpeta
    WShortCut.WorkingDirectory = Left(FileName, _
                                      Len(FileName) - Len(Dir(FileName)))
    ' indicamos los argumentos
    WShortCut.Arguments = Args
    'y grabamos el trabajo
    WShortCut.Save
    'una vez grabado el archivo se le cambia el nombre
    'si se ha pasado algún valor en el argumento LinkName
    If Not IsMissing(LinkName) Then
        LinkName = ShortCutPath & "\" & LinkName & ".lnk"
        Name WShortCut.FullName As LinkName
    End If
    CreateShortCut = -1

exit_CreateShortCut:

    Set WShortCut = Nothing
    Set WScript = Nothing
    On Error GoTo 0
    Exit Function

CreateShortCut_Error:

    ' si ha habido algún error, grabamos el número
    CreateShortCut = Err.Number
    ' y salimos
    Resume exit_CreateShortCut

End Function
'---------------------------------------------------------

Ejemplos:

Temas relacionados: