Como crear shortCut en Visual Basic
Deseo hacer una pequeña aplicación en VB que me permita hacer un shortcut a una página web y ponerle un imagen que deseo al short cut
Me podrías ayudar con eso
Me podrías ayudar con eso
1 respuesta
Respuesta de Roberto Alvarado
1
0
Roberto Alvarado
, Desarrollador de aplicaciones en plataforma
Aquí va el código:
'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
'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
Hola Experto, muchas gracias por el código
Tengo una duda, lo puse a correr y me salio este error "The shortcut pathname mus end with .lnk or .url"
Pregunta, si yo le quiero poner el acceso a Yahoo, por ejemplo, y con una icono que yo quisiera,... ¿cómo lo haría?
Gracias por tu ayuda
Tengo una duda, lo puse a correr y me salio este error "The shortcut pathname mus end with .lnk or .url"
Pregunta, si yo le quiero poner el acceso a Yahoo, por ejemplo, y con una icono que yo quisiera,... ¿cómo lo haría?
Gracias por tu ayuda
Muchas gracias experto, le modifique una linea para que haga el acceso directo de una página web y funciono de lo más bien, lo puse así
.TargetPath = "enlace externo/"
Ahora bien... como hago para poner un icono que yo deseo a ese shortcut, un icono ya definido por mi, como se puede hacer eso
Saludos,
.TargetPath = "enlace externo/"
Ahora bien... como hago para poner un icono que yo deseo a ese shortcut, un icono ya definido por mi, como se puede hacer eso
Saludos,
- Compartir respuesta