Shortcutting

[RTMP]

How can I create a shortcut in VB & NT4 without invoking the wizard.

[RTMP]

Thirteen people have viewed this but no replies??

Is this so hard to do?

[smiffe]

copy this into a module

Private Declare Function fCreateShellLink Lib "vb6stkit.dll" _
(ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, _
ByVal lpstrLinkPath As String, _
ByVal lpstrLinkArgs As String, ByVal fPrivate As Integer, _
ByVal sParent As String) As Long
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" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Private Type ShortItemId
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST
mkid As ShortItemId
End Type


Public Function CreateIcon(IconTitle As String, ProgramPath As String, _
Optional PutWhere As Integer = 0, Optional FolderName = "") As Boolean

Dim FolderPath As String
Dim StartMenId As ITEMIDLIST
Dim idlstr As Long
Dim sPath As String
Dim IDL As ITEMIDLIST

Const MAX_LENGTH = 260

On Error GoTo ErrorHandler

Select Case PutWhere
Case 0 'desktop
fCreateShellLink "..\..\Desktop", IconTitle, ProgramPath, "", -1, _
"$(Programs)"
Case 1 'StartMenu
fCreateShellLink "..", IconTitle, ProgramPath, "", -1, _
"$(Programs)"
Case 2 'StartMenu/Programs
fCreateShellLink "..\Programs", IconTitle, ProgramPath, "", -1, _
"$(Programs)"
Case 3 'StartMenu/Programs/FolderName
If FolderName = "" Then
GoTo ErrorHandler 'no FolderName entered
Else
idlstr = SHGetSpecialFolderLocation(0, &HB, IDL) 'get id to StartMenu
If idlstr = 0 Then 'no error
sPath = Space$(MAX_LENGTH)
idlstr = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath) 'get StartMenu Path from id list
If idlstr Then 'path returned
FolderPath = Left$(sPath, InStr(sPath, Chr$(0)) - 1) & "\" & _
"Programs\" & FolderName 'FolderPath = "../StartMenu/Programs/FolderName"
Else 'SHGetPathFromIDList returned nothing
GoTo ErrorHandler
End If
Else 'SHGetSpecialFolder returned an error
GoTo ErrorHandler
End If
If Dir(FolderPath, vbDirectory) = "" Then 'folder doesn't exist
MkDir (FolderPath) 'make it
End If
fCreateShellLink "..\Programs\" & FolderName, IconTitle, ProgramPath, "", -1, _
"$(Programs)"
End If
Case Else 'invalid call get out
GoTo ErrorHandler
End Select
CreateIcon = True
Exit Function
ErrorHandler:
CreateIcon = False
End Function

then in your prog call it like this
dim retVal as boolean
retVal = CreateIcon(string to be displayed under icon, path to program icon
should point to, putwhere, foldername)

putwhere is where you want the icon to appear
0 = desktop and is the default if nothing entered
1 = users startmenu
2 = startmenu under programs
3 = startmenu under programs under a folder

foldername is ignored unless putwhere = 3 and is the name of the folder
that the icon will be put under on the start menu under programs. If the
folder doesn't exist it will be created.

This is designed for visual basic 6. it will work under other vb editions but
you will have to make sure you have vb6stkit.dll which comes with vb6 and
is automatically added to your setup program by the package and deployment
wizard.

Hope this helps.