Advertisement
2002C Files/ File Controls/ Input/ Output #15584

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.

AI

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.

Quellcode
original-source
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
Originalkommentare (3)
Wiederhergestellt von der Wayback Machine