Sección de códigos , trucos y ejemplos para visual basic

127 - Crear un acceso Directo usando Windows Script Host

Ejemplo que crea un Shortcut o Acceso directo desde nuestra aplicacion utilizando Windows Scripting Host

Vista del ejemplo en visual basic que usa Windows Scripting host para crear ShortCuts

El código parece algo largo para algo tan simple, pero en realidad son solo un par de líneas de código, ya que la mayoría es código extra para listar algunas de las carpetas especiales windows, como el path del escritorio, menú inicio etc...

Colocar en el orden de la imagen

Combo1 (es donde se listan algunos paths de windows)
Un Text1 para indicar el nombre que tendrá el enlace
Un Command1 que lo crea

Código fuente en un formulario:

'Constantes para las carpetas especiales de windows '---------------------------------------------------- 'Escritorio de windows Private Const CSIDL_DESKTOP = &H0 'Carpeta de Inicio - Programas Private Const CSIDL_PROGRAMS = &H2 Private Const CSIDL_PERSONAL = &H5 'Carpeta Favoritos Private Const CSIDL_FAVORITES = &H6 'Inicio Private Const CSIDL_STARTUP = &H7 'Documentos recientes Private Const CSIDL_RECENT = &H8 Private Const CSIDL_STARTMENU = &HB Private Const CSIDL_COMMON_STARTMENU = &H16 Private Const CSIDL_COMMON_PROGRAMS = &H17 Private Const CSIDL_COMMON_STARTUP = &H18 Private Const CSIDL_COMMON_FAVORITES = &H1F 'Declaraciones del Api Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" ( _ ByVal hwndOwner As Long, _ ByVal nFolder As Long, _ pidl As ITEMIDLIST) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" ( _ ByVal pidl As Long, _ ByVal pszPath As String) As Long Private Const MAX_PATH = 260 Private Type SHITEMID cb As Long abID As Byte End Type Private Type ITEMIDLIST mkid As SHITEMID End Type 'Recupera el path de las carpetas y directorios especiales de windows Private Function GetSpecialfolder(CSIDL As Long) As String Dim ret As Long, IDL As ITEMIDLIST ret = SHGetSpecialFolderLocation(100, CSIDL, IDL) If ret = NOERROR Then Path$ = Space$(512) ret = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$) GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1) Exit Function End If GetSpecialfolder = "" End Function Private Sub Command1_Click() 'Nuevo objeto de tipo wscript.Shell Set obj = CreateObject("wscript.Shell") 'Crea el acceso directo en la carpeta erspecial indicada Set acceso_directo = obj.CreateShortcut(Combo1 & "\" & Text1) With acceso_directo ' Ruta del archivo al cual hacer el acceso directo .TargetPath = App.Path & "\" & App.EXEName 'Graba el cambio .Save End With ' Elimina el obeto Set obj = Nothing End Sub Private Sub Form_Load() Text1 = "Acceso_Directo_Prueba.lnk" 'Agega algunas rutas de las carpetas del sistema With Combo1 .AddItem GetSpecialfolder(CSIDL_DESKTOP) .AddItem GetSpecialfolder(CSIDL_PROGRAMS) .AddItem GetSpecialfolder(CSIDL_PERSONAL) .AddItem GetSpecialfolder(CSIDL_FAVORITES) .AddItem GetSpecialfolder(CSIDL_RECENT) .Text = .List(0) End With Me.Caption = " Ejemplo para crear un Acceso directo en vb " Command1.Caption = " Crear ShortCut " End Sub

Recursos vb 6.0 - Enlaces relacionados

Crear grupo de programas en windows

Buscar en Recursos vb