Creating shortcuts of application

Hi all,

Is there anyway to make a shortcut of a program that will run like the original, but is on the desktop? I need to do this because my program relies on two text files that I have in App.Path, and If i put it on the desktop I will need to put the folders on the desktop too and that won't work.


Does anyone know if this is possible?

Select your program in Windows Explorer then right click and create shortcut. Move it to the desktop or create it to the desktop.

VB Code:

Private Declare Function fCreateShellLink Lib "VB5STKIT.DLL" _
    (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, _
    ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long
 
dim lngRslt as long
 
lngRslt = fCreateShellLink("..\..\Desktop", ShortCutName, App.Path & "\exe.exe", (properties))

Great thanks to both

Here is what I use (written awhile ago) to create shortcurs on the desktop (you may need to add some logic to check if it altready exist but it isn't really necessary):

VB Code:

Option Explicit
 
Private Declare Function OSfCreateShellLink Lib "vb6stkit.dll" Alias "fCreateShellLink" _
                        (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, _
                         ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String, _
                         ByVal fPrivate As Long, ByVal sParent As String) As Long
 
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
                        (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long
 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                        (ByVal pidl As Long, ByVal pszPath As String) As Long
 
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
 
Private Const ERROR_SUCCESS = 0&
Private Const CSIDL_DESKTOPDIRECTORY = &H10       '{user}\Desktop
 
Private Sub Form_Load()
'============================
Dim strLinkName As String
Dim strFullPath As String
Dim strComLineArgs As String
Dim bPrivate As Boolean
Dim strParent As String
 
    strLinkName = App.EXEName & ".exe"
    strFullPath = App.Path & "\" & App.EXEName & ".exe"
    strComLineArgs = ""
    bPrivate = True
    strParent = "$(Programs)"
    
    CreateShortcut strLinkName, strFullPath, strComLineArgs, bPrivate, strParent
 
End Sub
 
Private Sub CreateShortcut(strLinkName As String, _
                           strFullPath As String, _
                           strComLineArgs As String, _
                           bPrivate As Boolean, _
                           strParent As String)
'======================================================
Dim sDeskPath As String
Dim Pos As Integer
Dim strDestination As String
 
On Error Resume Next
 
    sDeskPath = GetSpecialFolder(Me.hwnd, CSIDL_DESKTOPDIRECTORY)
    Pos = InStrRev(sDeskPath, "\")
    strDestination = "..\.." & Mid(sDeskPath, Pos)
    
    OSfCreateShellLink strDestination, strLinkName, strFullPath, _
                       strComLineArgs, bPrivate, strParent
 
End Sub
 
Public Function GetSpecialFolder(hwnd As Long, CSIDL As Long) As String
'========================================================================
Dim pidl As Long
Dim Pos As Long
Dim sPath As String
     
    'fill the pidl with the specified folder item
    If SHGetSpecialFolderLocation(hwnd, CSIDL, pidl) = ERROR_SUCCESS Then
        'initialize & get the path
        sPath = Space$(260)
        If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
            'check for a null
            Pos = InStr(sPath, Chr$(0))
            If Pos Then 'strip it
                GetSpecialFolder = Left$(sPath, Pos - 1)
            End If
            Call CoTaskMemFree(pidl)
        End If
    End If
    
End Function

One more question. How could I set all of the selected items in a file list box into an array? I tried this but only got the first item selected.

VB Code:

Private Sub cmdCopyTo_Click()
    Dim i As Integer
    If File1.ListIndex < 0 Then
        MsgBox "No Selected Songs.", vbCritical
        Exit Sub
    End If
    ReDim sFileName(File1.ListIndex - 1)
    For i = 0 To UBound(sFileName)
        sFileName(i) = File1.Path
        If Right$(sFileName(i), 1) <> "\" Then
            sFileName(i) = sFileName(i) & "\"
        End If
        sFileName(i) = sFileName(i) [COLOR=Red]& File1.Filename[/COLOR]
    Next i
    blnCopy = True
End Sub

I'm pretty sure that the part in red is what is wrong. But I can't figure out how to get the first, second, third, ect file name in the file list box

Here is modified version (untested) so give it the try and let em know if works for you:

VB Code:

Private Sub Command1_Click()
Dim i As Integer
 
    If File1.ListIndex < 0 Then
        MsgBox "No Selected Songs.", vbCritical
        Exit Sub
    End If
    
    ReDim sFileName(0)
    blnCopy = False
    
    For i = 0 To File1.ListCount - 1
        If File1.Selected(i) = True Then
            sFileName(UBound(sFileName)) = File1.List(i)
            ReDim Preserve sFileName(UBound(sFileName) + 1)
        End If
    Next i
    If UBound(sFileName) > 0 Then
        If Trim(sFileName(UBound(sFileName))) = "" Then
            ReDim Preserve sFileName(UBound(sFileName) - 1)
        End If
    End If
    If Trim(sFileName(0)) <> "" Then
        blnCopy = True 'not sure what this is for ???
    End If
 
End Sub

Use

VB Code:

For i = 0 To File1.ListIndex - 1
 
and
 
If File1.Item(i).Selected Then

Quote:

---

Originally Posted by randem

Use

VB Code:

For i = 0 To File1.ListIndex - 1

---

How ListIndex be helpfull in the that loop ?

Youre right I did not look properly at the portion of the line I copied from the original code. I assumed he had it right... Incorrectly I add

Quote:

---

Originally Posted by RhinoBull

Here is modified version (untested) so give it the try and let em know if works for you:

VB Code:

Private Sub Command1_Click()
Dim i As Integer
 
    If File1.ListIndex < 0 Then
        MsgBox "No Selected Songs.", vbCritical
        Exit Sub
    End If
    
    ReDim sFileName(0)
    blnCopy = False
    
    For i = 0 To File1.ListCount - 1
        If File1.Selected(i) = True Then
            sFileName(UBound(sFileName)) = File1.List(i)
            ReDim Preserve sFileName(UBound(sFileName) + 1)
        End If
    Next i
    If UBound(sFileName) > 0 Then
        If Trim(sFileName(UBound(sFileName))) = "" Then
            ReDim Preserve sFileName(UBound(sFileName) - 1)
        End If
    End If
    If Trim(sFileName(0)) <> "" Then
        blnCopy = True 'not sure what this is for ???
    End If
 
End Sub

---

Ok, I should have just asked this to, but I need the directory of the file list box infront of the names.

Ok, sorry I have so many questions on one thread, but how come I have no "FileSystemObject" in my references?

I'm trying to use this code

VB Code:

'Set A Reference To FileSystemObject
 
Private Function FileCount(ByVal FolderName As String) As Long
Dim objFS As New Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
 
If objFS.FolderExists(FolderName) Then
    Set objFolder = objFS.GetFolder(FolderName)
    'if this lines returns more than 0, the folder has files
    FileCount = objFolder.Files.Count
End If
 
Set objFolder = Nothing
Set objFS = Nothing
 
End Function
 
Private Sub cmdCheckForFiles_Click()
MsgBox FileCount("C:\windows\system")
End Sub

Sorry paralinx but I don't quite follow you - maybe it's time for you to split this thread ...

Look for Microsoft Scripting Runtime in components.

Quote:

---

Originally Posted by dglienna

Look for Microsoft Scripting Runtime in components.

---

Actually, it is a reference.