Desktop Shortcut

Printable View

Dec 19th, 2001, 12:32 AM
elbimbo

Desktop Shortcut

Hello there,

I want to create a shortcut icon on the desktop of my application. how can i do this automatically using vb.

thanks in advance.

VB Code:

'http://www.vbweb.co.uk/show.asp?id=245
 
'Creating a shortcut In VB Is far more complicated than it should be. 
'The easiest way To create a shortcut Is To Add it To the recent documents list, 
'And Then move it To where you want it To go.
 
'First, the code below finds out where the Recent Documents And the Desktop folder 
'Is, using the fGetSpecialFolder Function In the module code. This Is so we can copy 
'the file from the Recent Documents To the Desktop. If you want To Put it somewhere Else, 
'either Set sDesktopPath To an actual path, 'Or use fGetSpecialFolder using the CSIDL_* 
'constants.
 
'Then, the code calls the SHAddToRecentDocs API passing the Text In txtFilePath, And 
'pauses For 1 1/2 seconds To ensure that it has been created. If successful, it Then 
'works out the Name of the file the API has created, And Then moves it To the desktop. 
'Finally, it renames the file To the caption 'specified In txtName.... And that's it!
 
'Module Code
Public Const CSIDL_DESKTOP = &H0 '// The Desktop - virtual folder
Public Const CSIDL_PROGRAMS = 2 '// Program Files
Public Const CSIDL_CONTROLS = 3 '// Control Panel - virtual folder
Public Const CSIDL_PRINTERS = 4 '// Printers - virtual folder
Public Const CSIDL_DOCUMENTS = 5 '// My Documents
Public Const CSIDL_FAVORITES = 6 '// Favourites
Public Const CSIDL_STARTUP = 7 '// Startup Folder
Public Const CSIDL_RECENT = 8 '// Recent Documents
Public Const CSIDL_SENDTO = 9 '// Send To Folder
Public Const CSIDL_BITBUCKET = 10 '// Recycle Bin - virtual folder
Public Const CSIDL_STARTMENU = 11 '// Start Menu
Public Const CSIDL_DESKTOPFOLDER = 16 '// Desktop folder
Public Const CSIDL_DRIVES = 17 '// My Computer - virtual folder
Public Const CSIDL_NETWORK = 18 '// Network Neighbourhood - virtual folder
Public Const CSIDL_NETHOOD = 19 '// NetHood Folder
Public Const CSIDL_FONTS = 20 '// Fonts folder
Public Const CSIDL_SHELLNEW = 21 '// ShellNew folder 
Public Const FO_MOVE = &H1
Public Const FO_RENAME = &H4
Public Const FOF_SILENT = &H4
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_RENAMEONCOLLISION = &H8
Public Const MAX_PATH As Integer = 260
Public Const SHARD_PATH = &H2&
Public Const SHCNF_IDLIST = &H0
Public Const SHCNE_ALLEVENTS = &H7FFFFFFF
 
Public Type SHFILEOPSTRUCT
    hwnd   As Long
    wFunc As Long
    pFrom As String
    pTo     As String
    fFlags  As Integer
    fAborted       As Boolean
    hNameMaps As Long
    sProgress      As String
End Type
 
Public Type ****EMID
    cb As Long
    abID As Byte
End Type
 
Public Type ITEMIDLIST
    mkid As ****EMID
End Type
 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function SHGetSpecialFolderLocation Lib "Shell32.dll" _
        (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Declare Function SHGetSpecialFolderLocationD Lib "Shell32.dll" Alias _
        "SHGetSpecialFolderLocation" (ByVal hwndOwner As Long, ByVal nFolder As Long, _
        ByRef ppidl As Long) As Long
Declare Function SHAddToRecentDocs Lib "Shell32.dll" (ByVal dwflags As Long, _
        ByVal dwdata As String) As Long
Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" _
        (lpFileOp As SHFILEOPSTRUCT) As Long
Declare Function SHChangeNotify Lib "Shell32.dll" (ByVal wEventID As Long, _
        ByVal uFlags As Long, ByVal dwItem1 As Long, ByVal dwItem2 As Long) As Long
Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias "SHGetPathFromIDListA" _
        (ByVal pidl As Long, ByVal pszPath As String) As Long
 
Public Function fGetSpecialFolder(CSIDL As Long) As String
Dim sPath As String
Dim IDL As ITEMIDLIST
'
' Retrieve info about system folders such as the "Recent Documents" folder.
' Info is stored in the IDL structure.
'
fGetSpecialFolder = ""
If SHGetSpecialFolderLocation(Form1.hwnd, CSIDL, IDL) = 0 Then
    '
    ' Get the path from the ID list, and return the folder.
    '
    sPath = Space$(MAX_PATH)
    If SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath) Then
        fGetSpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1) & "\"
    End If
End If
End Function
 
 
'Form Code
Private Sub cmdCreate_Click()
Dim i As Integer
Dim lResult As Long
Dim lpil As Long
Dim sFilePath As String
Dim sFileName As String
Dim sRecentPath As String
Dim sDesktopPath As String
Dim sFilePathOld As String
Dim sFilePathNew As String
Dim sShortCutName As String
Dim sMsg As String
Dim SHFileOp As SHFILEOPSTRUCT
'
' Add a shortcut to the Windows desktop.
'
' Get the .exe path and display name associated with the
' button that was right clicked (determined by ptbrRightButton).
'
If Trim$(txtFilePath) = "" Then Exit Sub
If Trim$(txtName) = "" Then Exit Sub
 
On Error GoTo cmdCreateError
Screen.MousePointer = vbHourglass
sFilePath = Trim$(txtFilePath)
sShortCutName = Trim$(txtName) & ".lnk"
'
' Get the paths of the folders to add the shortcuts to.
' The folders are the Recent Files List and the Desktop.
'
sRecentPath = fGetSpecialFolder(CSIDL_RECENT)
'
' NOTE: to create the shortcut in another folder, set sDesktopPath 
' to that folder.
'
sDesktopPath = fGetSpecialFolder(CSIDL_DESKTOPDIRECTORY)
sMsg = "Error retrieving folder location."
If sRecentPath <> "" And sDesktopPath <> "" Then
    '
    ' Create a shortcut in the Recent Files list.
    '
    sMsg = "Error adding shortcut to the Recent File list."
    lResult = SHAddToRecentDocs(SHARD_PATH, sFilePath)
    Sleep (1500)
    If lResult Then
        '
        ' Extract the .exe name from the path.
        '
        i = 1
        sFileName = sFilePath
        Do While i
            i = InStr(1, sFileName, "\")
            If i Then sFileName = Mid$(sFileName, i + 1)
        Loop
        '
        ' Move the shortcut from the Recent folder to the Desktop.
        ' Since the shortcut now resides in the Recent folder,
        ' modify the file name to include the Recent folder
        ' path. Also, append ".lnk" to the original filename.
        '
        sFilePath = sRecentPath & sFileName & ".lnk" & vbNullChar & vbNullChar
        With SHFileOp
            .wFunc = FO_MOVE
            .pFrom = sFilePath
            .pTo = sDesktopPath
            .fFlags = FOF_SILENT
        End With
 
        sMsg = "Error creating desktop shortcut."
        lResult = SHFileOperation(SHFileOp)
        Sleep (1500)
        If lResult = 0 Then
            '
            ' Rename the link.
            '
            sFilePathOld = sDesktopPath & sFileName & ".lnk" & vbNullChar & vbNullChar
            sFilePathNew = sDesktopPath & sShortCutName & vbNullChar & vbNullChar
            With SHFileOp
                .wFunc = FO_RENAME
                .pFrom = sFilePathOld
                .pTo = sFilePathNew
                .fFlags = FOF_SILENT Or FOF_RENAMEONCOLLISION
            End With
            sMsg = "Error renaming desktop shortcut."
            lResult = SHFileOperation(SHFileOp) '123 = can't rename.
            sMsg = ""
            '
            ' Refresh the desktop to display the shortcut.
            '
           Call SHGetSpecialFolderLocationD(Me.hwnd, CSIDL_DESKTOP, lpil)
           Call SHChangeNotify(SHCNE_ALLEVENTS, SHCNF_IDLIST, lpil, 0)
        End If
    End If
End If
 
Screen.MousePointer = vbDefault
    Exit Sub
 
cmdCreateError:
    MsgBox "Error creating desktop shortcut. " & sMsg, vbExclamation, "Create Shortcut"
End Sub

Jan 23rd, 2003, 07:54 PM
elbimbo

RESOLVED!

Hello there,

I have post this question coz i like to create a shortcut of my application during the installation. And my solution is using the Visual Studio Installer 1.1! If your interested to know how I can share it with you. Just e-mail [email protected]

Quote:

Originally posted by peet

VB Code:

'http://www.vbweb.co.uk/show.asp?id=245

'Creating a shortcut In VB Is far more complicated than it should be.
'The easiest way To create a shortcut Is To Add it To the recent documents list,
'And Then move it To where you want it To go.

'First, the code below finds out where the Recent Documents And the Desktop folder
'Is, using the fGetSpecialFolder Function In the module code. This Is so we can copy
'the file from the Recent Documents To the Desktop. If you want To Put it somewhere Else,
'either Set sDesktopPath To an actual path, 'Or use fGetSpecialFolder using the CSIDL_*
'constants.

'Then, the code calls the SHAddToRecentDocs API passing the Text In txtFilePath, And
'pauses For 1 1/2 seconds To ensure that it has been created. If successful, it Then
'works out the Name of the file the API has created, And Then moves it To the desktop.
'Finally, it renames the file To the caption 'specified In txtName.... And that's it!

'Module Code
Public Const CSIDL_DESKTOP = &H0 '// The Desktop - virtual folder
Public Const CSIDL_PROGRAMS = 2 '// Program Files
Public Const CSIDL_CONTROLS = 3 '// Control Panel - virtual folder
Public Const CSIDL_PRINTERS = 4 '// Printers - virtual folder
Public Const CSIDL_DOCUMENTS = 5 '// My Documents
Public Const CSIDL_FAVORITES = 6 '// Favourites
Public Const CSIDL_STARTUP = 7 '// Startup Folder
Public Const CSIDL_RECENT = 8 '// Recent Documents
Public Const CSIDL_SENDTO = 9 '// Send To Folder
Public Const CSIDL_BITBUCKET = 10 '// Recycle Bin - virtual folder
Public Const CSIDL_STARTMENU = 11 '// Start Menu
Public Const CSIDL_DESKTOPFOLDER = 16 '// Desktop folder
Public Const CSIDL_DRIVES = 17 '// My Computer - virtual folder
Public Const CSIDL_NETWORK = 18 '// Network Neighbourhood - virtual folder
Public Const CSIDL_NETHOOD = 19 '// NetHood Folder
Public Const CSIDL_FONTS = 20 '// Fonts folder
Public Const CSIDL_SHELLNEW = 21 '// ShellNew folder
Public Const FO_MOVE = &H1
Public Const FO_RENAME = &H4
Public Const FOF_SILENT = &H4
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_RENAMEONCOLLISION = &H8
Public Const MAX_PATH As Integer = 260
Public Const SHARD_PATH = &H2&
Public Const SHCNF_IDLIST = &H0
Public Const SHCNE_ALLEVENTS = &H7FFFFFFF

Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type

Public Type ****EMID
cb As Long
abID As Byte
End Type

Public Type ITEMIDLIST
mkid As ****EMID
End Type

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function SHGetSpecialFolderLocation Lib "Shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Declare Function SHGetSpecialFolderLocationD Lib "Shell32.dll" Alias _
"SHGetSpecialFolderLocation" (ByVal hwndOwner As Long, ByVal nFolder As Long, _
ByRef ppidl As Long) As Long
Declare Function SHAddToRecentDocs Lib "Shell32.dll" (ByVal dwflags As Long, _
ByVal dwdata As String) As Long
Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
Declare Function SHChangeNotify Lib "Shell32.dll" (ByVal wEventID As Long, _
ByVal uFlags As Long, ByVal dwItem1 As Long, ByVal dwItem2 As Long) As Long
Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Public Function fGetSpecialFolder(CSIDL As Long) As String
Dim sPath As String
Dim IDL As ITEMIDLIST
'
' Retrieve info about system folders such as the "Recent Documents" folder.
' Info is stored in the IDL structure.
'
fGetSpecialFolder = ""
If SHGetSpecialFolderLocation(Form1.hwnd, CSIDL, IDL) = 0 Then
'
' Get the path from the ID list, and return the folder.
'
sPath = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath) Then
fGetSpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1) & "\"
End If
End If
End Function

'Form Code
Private Sub cmdCreate_Click()
Dim i As Integer
Dim lResult As Long
Dim lpil As Long
Dim sFilePath As String
Dim sFileName As String
Dim sRecentPath As String
Dim sDesktopPath As String
Dim sFilePathOld As String
Dim sFilePathNew As String
Dim sShortCutName As String
Dim sMsg As String
Dim SHFileOp As SHFILEOPSTRUCT
'
' Add a shortcut to the Windows desktop.
'
' Get the .exe path and display name associated with the
' button that was right clicked (determined by ptbrRightButton).
'
If Trim$(txtFilePath) = "" Then Exit Sub
If Trim$(txtName) = "" Then Exit Sub

On Error GoTo cmdCreateError
Screen.MousePointer = vbHourglass
sFilePath = Trim$(txtFilePath)
sShortCutName = Trim$(txtName) & ".lnk"
'
' Get the paths of the folders to add the shortcuts to.
' The folders are the Recent Files List and the Desktop.
'
sRecentPath = fGetSpecialFolder(CSIDL_RECENT)
'
' NOTE: to create the shortcut in another folder, set sDesktopPath
' to that folder.
'
sDesktopPath = fGetSpecialFolder(CSIDL_DESKTOPDIRECTORY)
sMsg = "Error retrieving folder location."
If sRecentPath <> "" And sDesktopPath <> "" Then
'
' Create a shortcut in the Recent Files list.
'
sMsg = "Error adding shortcut to the Recent File list."
lResult = SHAddToRecentDocs(SHARD_PATH, sFilePath)
Sleep (1500)
If lResult Then
'
' Extract the .exe name from the path.
'
i = 1
sFileName = sFilePath
Do While i
i = InStr(1, sFileName, "\")
If i Then sFileName = Mid$(sFileName, i + 1)
Loop
'
' Move the shortcut from the Recent folder to the Desktop.
' Since the shortcut now resides in the Recent folder,
' modify the file name to include the Recent folder
' path. Also, append ".lnk" to the original filename.
'
sFilePath = sRecentPath & sFileName & ".lnk" & vbNullChar & vbNullChar
With SHFileOp
.wFunc = FO_MOVE
.pFrom = sFilePath
.pTo = sDesktopPath
.fFlags = FOF_SILENT
End With

sMsg = "Error creating desktop shortcut."
lResult = SHFileOperation(SHFileOp)
Sleep (1500)
If lResult = 0 Then
'
' Rename the link.
'
sFilePathOld = sDesktopPath & sFileName & ".lnk" & vbNullChar & vbNullChar
sFilePathNew = sDesktopPath & sShortCutName & vbNullChar & vbNullChar
With SHFileOp
.wFunc = FO_RENAME
.pFrom = sFilePathOld
.pTo = sFilePathNew
.fFlags = FOF_SILENT Or FOF_RENAMEONCOLLISION
End With
sMsg = "Error renaming desktop shortcut."
lResult = SHFileOperation(SHFileOp) '123 = can't rename.
sMsg = ""
'
' Refresh the desktop to display the shortcut.
'
Call SHGetSpecialFolderLocationD(Me.hwnd, CSIDL_DESKTOP, lpil)
Call SHChangeNotify(SHCNE_ALLEVENTS, SHCNF_IDLIST, lpil, 0)
End If
End If
End If

Screen.MousePointer = vbDefault
Exit Sub

cmdCreateError:
MsgBox "Error creating desktop shortcut. " & sMsg, vbExclamation, "Create Shortcut"
End Sub

Using "WScript", its that much more shorter and easier

http://www.experts-exchange.com/Prog..._20395968.html

Jan 26th, 2003, 08:15 PM
elbimbo

No Code needed

Hi,

those codes were too long. Using Visual Studio Installer you only need one line with less than 30 characters.