Adjuntar a rutina para crear acceso directo del archivo

Te anexo la macro para crear un acceso directo.

Actualiza en la macro ruta y archivo

Sub accesodirecto()
Dim numError As Long
Dim ruta, archivo, todo As String
ruta = "C:\Documents and Settings\Mis documentos\Soporte expertos\"
archivo = "prueba.xls"
todo = ruta & archivo
    numError = CreateShortCut(todo, "Desktop", , "Acceso a " & archivo)
    If numError = -1 Then
        MsgBox "Se ha creado un acceso directo en el escritorio"
    Else
        MsgBox "Error: " & numError & vbCrLf & vbCrLf _
        & "No se pudo completar la operación"
    End If
End Sub
'---------------------------------------------------------
'
' 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
'
'     [email protected]
'
' 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
'---------------------------------------------------------

saludos.dam

ok bien lo que no entiendo es si lo debo poner dentro de la rutina o llamar la macro si es asi como le ago para que me ponga el mismo nombre que le otorgue al archivo.

bueno si va dentro de la rutina solo edito lar rutas verdad

gracias

ya para cerrar la pregunta y puntear

gracias de nuevo