Acceso directo

[xDie]

Hola alguien sabe comopeudo crear un acceso directo, se qeu se peude con whs pero no se como gracias

[CeLaYa]

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

[xDie]

Gracias celaya, ya lo habi encontrado y no se porque no me funca rebisare liena por linea

[CeLaYa]

me he dado cuenta que muchas de las api's necesitan que manejes los paths cortos (ejem: c:\misdoc~1\algo~2\archiv~.ico) tal vez ese sea el problema