Acceso directo

estos son unos ejemplos que vienen el la pag de "El Guille" (http://www.elguille.info/vb/ejemplos/crear_links.htm)

' Crear accesos directos usando DDE ------
Option Explicit

Private Sub cmdCrear_Click()
' Crear el acceso directo
' Se creará dentro de Programas del Menú de Inicio
'
CrearIconoEnProgMan Me, Text2.Text, Text1.Text
End Sub

Private Sub cmdSalir_Click()
' Salir del programa
Unload Me
End Sub

'----------------------------------------------------------
' Procedure: CrearIconoEnProgMan
'
' Arguments: X The form where Label1 exists
'
' CmdLine$ A string that contains the command
' line for the item/icon.
' ie 'c:\myapp\setup.exe'
'
' IconTitle$ A string that contains the item's
' caption
'----------------------------------------------------------
Private Sub CrearIconoEnProgMan(X As Form, CmdLine$, IconTitle$)

Dim i As Integer, z As Integer

Screen.MousePointer = 11
' Poner la primera letra en mayúsculas
IconTitle$ = Left$(IconTitle$, 1) & LCase$(Mid$(IconTitle$, 2))

'----------------------------------------------------------------------
' Windows requires DDE in order to create a program group and item.
' Here, a Visual Basic label control is used to generate the DDE messages
'----------------------------------------------------------------------
On Error Resume Next

'---------------------------------
' Set LinkTopic to PROGRAM MANAGER
'---------------------------------
X.Label1.LinkTopic = "ProgMan|Progman"
X.Label1.LinkMode = 2
For i = 1 To 10 ' Loop to ensure that there is enough time to
z = DoEvents() ' process DDE Execute. This is redundant but needed
Next ' for debug windows.
X.Label1.LinkTimeout = 100

'------------------------------------------------
' Create Program Item, one of the icons to launch
' an application from Program Manager
'------------------------------------------------
X.Label1.LinkExecute "[AddItem(" & CmdLine$ & Chr$(44) & IconTitle$ & Chr$(44) & ",,)]"

'-----------------
' Reset properties
'-----------------
X.Label1.LinkTimeout = 50
X.Label1.LinkMode = 0

Screen.MousePointer = 0
End Sub

'-----------------------------------------------------------------------' Crear accesos directos usando WHS Option Explicit

Private m_wsShell As Variant

Private Sub cmdCrear_Click()
Dim sLnkPath As String
Dim sLink As String
Dim sAppPath As String
Dim vLnk As Variant

sAppPath = Text2
sLink = Text1
If InStr(sLink, ".lnk") = 0 Then
sLink = sLink & ".lnk"
End If
' Crearlo en el escritorio:
'sLnkPath = m_wsShell.SpecialFolders("Desktop")
'
' Crearlo en el indicado en el listbox
' Aunque siempre lo crea en el mismo sitio:
' C:\WINDOWS\All Users\Desktop
' es decir en el escritorio.
'
' Pero eso era usando TEXT3 a secas,
' añadiendo el .Text ya si que sale lo que debe salir...
'
sLnkPath = m_wsShell.SpecialFolders(Text3.Text)
sLnkPath = sLnkPath & "\" & sLink

' Crear el acceso directo
Set vLnk = m_wsShell.CreateShortcut(sLnkPath)
vLnk.Targetpath = sAppPath

' definir directorio de trabajo
vLnk.WorkingDirectory = "D:\gsCodigo" ' Escribe aquí el directorio
'--------------------------------------------------------------------------
'
vLnk.Save
End Sub

Private Sub cmdSalir_Click()
' Salir del programa
Unload Me
End Sub

Private Sub Form_Load()
Set m_wsShell = CreateObject("WScript.Shell")

List1.Clear

' Llenar el listbox con los "folders" de SpecialFolders
'
'Dim vName As Variant

' (Este método es preferible si quieres mostrar todos las carpetas especiales)

'For Each vName In m_wsShell.SpecialFolders
' List1.AddItem vName
'Next
'
'
' Estos no son válidos para el W95
List1.AddItem "AllUsersDesktop= " & m_wsShell.SpecialFolders("AllUsersDesktop")
'List1.AddItem "AllUsersStartMenu= " & m_wsShell.SpecialFolders("AllUsersStartMenu")
'List1.AddItem "AllUsersPrograms= " & m_wsShell.SpecialFolders("AllUsersPrograms")
'List1.AddItem "AllUsersStartup= " & m_wsShell.SpecialFolders("AllUsersStartup")
'
List1.AddItem "Desktop= " & m_wsShell.SpecialFolders("Desktop")
List1.AddItem "Programs= " & m_wsShell.SpecialFolders("Programs")
List1.AddItem "StartMenu= " & m_wsShell.SpecialFolders("StartMenu")
List1.AddItem "Startup= " & m_wsShell.SpecialFolders("Startup")
List1.AddItem "MyDocuments= " & m_wsShell.SpecialFolders("MyDocuments")
List1.ListIndex = 0
'
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set m_wsShell = Nothing
End Sub

Private Sub List1_Click()
' Mostrar el destino del acceso directo
Dim sTmp As String
Dim i As Long

sTmp = List1.List(List1.ListIndex)
i = InStr(sTmp, "= ")
If i Then
Text3 = Left$(sTmp, i - 1)
Else
Text3 = "Desktop"
End If
End Sub