¿como crear un acceso directo con vb?

[ccca001]

hola de nuevo, ya logre hacer algo asi como un instalador para mi programa, solo me falta poder crear un acceso directo en el menu programas... y no se como crear el acceso directo para que direccione al programa...
uds saben? si es asi haganmelo saber por favor...

gracias...

[vbx3m]

En un modulo pones:

Function CreateShortCut( _
FileName As String, _
Destination As Variant, _
Optional Args As String) As Long

Dim WScript As Object
Dim WShortCut As Object
Dim ShortCutPath As String

On Error GoTo CreateShortCut_Error
If Len(Dir(FileName)) = 0 Then Err.Raise 52
Set WScript = CreateObject("WScript.Shell")
ShortCutPath = WScript.SpecialFolders(Destination)
If Len(ShortCutPath) = 0 Then
ShortCutPath = Destination
If Len(Dir(ShortCutPath, vbDirectory)) = 0 Then
Err.Raise 52
End If
End If
Set WShortCut = WScript.CreateShortCut _
(ShortCutPath & "\" & Dir(FileName) & ".lnk")
WShortCut.TargetPath = FileName
' Aqui puedes indicar el icono
WShortCut.IconLocation = FileName & ", 0"
WShortCut.WorkingDirectory = Left(FileName, _
Len(FileName) - Len(Dir(FileName)))
' indicas los argumentos
WShortCut.Arguments = Args
WShortCut.Save
CreateShortCut = -1

exit_CreateShortCut:

Set WShortCut = Nothing
Set WScript = Nothing
On Error GoTo 0
Exit Function

CreateShortCut_Error:

CreateShortCut = Err.Number
Resume exit_CreateShortCut

End Function


y en el form:

Dim numError As Long
numError = CreateShortCut("C:\ruta.exe", "Desktop")
'Puede ser cualquier tipo de archivo
'si lo vas a hacer en Inicio->Programas pones "Programs"
'mis documentos "MyDocuments"
'menu inicio "StartMenu"

If numError = -1 Then
MsgBox "Se ha creado el acceso directo"
Else
MsgBox "Error: " & numError & vbCrLf & vbCrLf _
& "No se pudo completar la operación"
End If
espero te sirva...

[ccca001]

funciono perfectamente, ahora, tengo otra consulta, he estado averiguando en internet pero no encuentro nada, y es como quitar la propiedad de solo lectura de una carpeta con visual basic ... tienes alguna idea...?

gracias...

[vbx3m]

Pon esto:

Option Explicit
Dim FName As String
Dim File As String
Const FILE_ATTRIBUTE_READONLY = &H1

Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileSpec As String, ByVal dwFileAttributes As Long) As Long

Private Sub Command1_Click()
Dim attr As Long
If Checkbox1.Value = Checked Then 'Si es True marca solo lectura si lo desmarcas le quitas esa propiedad

attr = FILE_ATTRIBUTE_READONLY
End If
SetFileAttributes File, attr
End Sub

Private Sub File1_Click()
File = Dir1.Path
If Right(File, 1) <> "\" Then
File = File & "\"
End If
File = File & File1.List(File1.ListIndex)
FName = File1.FileName
End Sub

Espero te sirva...