Create a shortcut with the Windows Scripting Host (no VB6STKIT)
I wanted code that used components that were mostly likely to be found on a user's machine. VB5STKIT, VB4STKIT, and VB6STKIT all could be used for creating shortcuts, but there is a good chance they weren't already on the user's machine, meaning I'd have to include it in my install package. The Windows Scripting Host is a default installation on Windows 98 and higher, and is likely on a Windows 95 machine. Plus you can include an object test to easily verify the user has the Scripting Host installed.
KI-Zusammenfassung: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.
Public Function CreateShortcut( _
ByVal sShortcutPath As String, _
ByVal sDescription As String, _
ByVal sTargetPath As String, _
Optional ByVal sArguments As String, _
Optional ByVal sWorkingDirectory As String, _
Optional ByVal sHotKey As String, _
Optional ByVal sIconLocation As String, _
Optional ByVal iWindowStyle As Integer = 3) As Boolean
'To get this to work for VB Script, Change the two lines below to: Dim sh, link.
Dim sh As Object
Dim link As Object
'Dynamically create the Script Object
Set sh = CreateObject("WScript.Shell")
'Check the path supplied and make sure the correct extension is on it.
If LCase(Right(sShortcutPath, 4)) = ".lnk" Or LCase(Right(sShortcutPath, 4)) = ".url" Then
Else
sShortcutPath = sShortcutPath & ".lnk"
End If
'Check that the Scripting Host is installed by confirming that an object was truly created.
If IsObject(sh) Then
Set link = sh.CreateShortcut(sShortcutPath)
If IsObject(link) Then
If IsMissing(sArguments) Then
Else
link.Arguments = sArguments
End If
link.Description = sDescription
If IsMissing(sHotKey) Then
Else
link.HotKey = sHotKey
End If
If IsMissing(sIconLocation) Then
sIconLocation = sTargetPath & ",1"
End If
link.IconLocation = sIconLocation
link.TargetPath = sTargetPath
link.WindowStyle = iWindowStyle
If IsMissing(sWorkingDirectory) Then
link.WorkingDirectory = sTargetPath
Else
link.WorkingDirectory = sWorkingDirectory
End If
'Now that the shortcut is fully created, you must save it.
link.Save
CreateShortcut = True
End If
End If
End Function