A raíz de una pregunta de McPegasus sobre este tema, he construido unas
funciones para crear un acceso directo de un fichero en el escritorio de
Windows por código.

El caso es que existe una API (fCreateShellLink, para quien quiera saberlo)
que ya hace eso, pero al parecer tiene alguna que otra pega. Para mi la
prinicipal pega es que forma parte de una de las librerías de VB y no
siempre estará disponible, a diferencia de las librerías estandar de
Windows. También parece ser que hay alguna dificultad cuando se trata de
distintos PCs (si no he entendido mal leyendo del inglés).

De cualquier forma, aquí tenéis el código. Espero que esté todo correcto.

'******** Código **********
'
' Código para crear un acceso
' directo de un fichero en el
' escritorio de Windows
'
' Funciones:
'    crearAccesoDirecto
'    obtenerCarpeta
'    nomFichero
'
' Autor: Juan M. Afán de Ribera
' Fecha: Mayo 2003
'
' Basado en una idea original de
' Randy Birch
' URL: http://www.mvps.org/vbnet/
'
' Si alguien trabajara con la
' versión 97 de Access mejor
' que pase por la dirección
' (en una sola línea)
'
http://personal.telefonica.terra.es/web/medicofamilia/simularfunciones97.txt
' para descargar las funciones
' que se encuentran en esa
' página (aquí utilizamos la
' función InStrRev)
'
' Suerte!
Option Explicit

'para poner en un módulo estandar
Private Const CSIDL_RECENT = &H8
Private Const CSIDL_DESKTOPDIRECTORY = &H10
Private Const SHARD_PATH = &H2

Private Declare Function SHAddToRecentDocs Lib "shell32" _
  (ByVal dwFlags As Long, _
   ByVal dwData As String) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" _
   Alias "SHGetPathFromIDListA" _
  (ByVal pidl As Long, _
   ByVal pszPath As String) As Long

Private Declare Function SHGetSpecialFolderLocation Lib "shell32" _
  (ByVal hwndOwner As Long, _
   ByVal nFolder As Long, _
     pidl As Long) As Long

Function crearAccesoDirecto(rutaFichero As String) As Boolean
Dim carpetaDocumentos As String
Dim carpetaEscritorio As String
Dim nomAccesoRecientes As String
Dim nomAccesoEscritorio As String

   carpetaDocumentos = obtenerCarpeta(CSIDL_RECENT)
   carpetaEscritorio = obtenerCarpeta(CSIDL_DESKTOPDIRECTORY)

   Call SHAddToRecentDocs(SHARD_PATH, rutaFichero)

   nomAccesoRecientes = carpetaDocumentos & _
      nomFichero(rutaFichero) & ".lnk"
   nomAccesoEscritorio = carpetaEscritorio & _
      nomFichero(rutaFichero) & ".lnk"

   FileCopy nomAccesoRecientes, nomAccesoEscritorio

   Kill nomAccesoRecientes

End Function

Function obtenerCarpeta(CSIDL As Long) As String
Dim carpeta As String
Dim pidl As Long

   If SHGetSpecialFolderLocation(&O0, CSIDL, pidl) = 0 Then
     carpeta = Space(255)

      If SHGetPathFromIDList(ByVal pidl, ByVal carpeta) Then
         obtenerCarpeta = Left(carpeta, _
            InStr(carpeta, Chr$(0)) - 1) & "\"
      End If

   End If
End Function

Function nomFichero(rutaFichero As String) As String
   nomFichero = Right(rutaFichero, Len(rutaFichero) _
      - InStrRev(rutaFichero, "\"))
End Function
'********* Fin Código **********

--
Saludos desde Barcelona
Juan M. Afan de Ribera
MVP [Ms Access]