I made a subroutine in order to create a shortcut for the current vbscript or any other application with arguments using an array that can be called as follow :
- Create a shortcut to the current vbscript on the Desktop
Create_Shortcut Array("Desktop","ShortcutName",WScript.ScriptFullName)
OR
- Create a shortcut to the current vbscript on the User Startup Folder
Create_Shortcut Array("Startup","ShortcutName",WScript.ScriptFullName)
OR
- Create a shortcut for Network Diagnostics with arguments to fix connections problems on Desktop
Create_Shortcut Array(_
"Desktop",_
"NetworkDiagnostics",_
"%SystemRoot%\system32\msdt.exe",_
"-skip TRUE -path %Windir%\diagnostics\system\networking -ep NetworkDiagnosticsPNI",_
"%SystemRoot%\system32\msdt.exe,0",_
"Network Diagnostics to fix connections problems",_
"CTRL+ALT+D"_
)
Remark : I added two subroutines RunAsAdmin()
and ShowError()
to handle any error that can raise up for creating this shortcut
Run_As_Admin_Create_Shortcut.vbs
'-------------------------------------------------------------------------------------------------------
'About WshShell.SpecialFolders
'Obtain the full path to any of the special Windows folders (Desktop, Start Menu etc).
'Syntax
' strMyPath = objShell.SpecialFolders("strFolderName")
' or
' strMyPath = objShell.SpecialFolders.Item("strFolderName")
'Arguments:
' objShell A WScript.Shell object
' strFolderName : One of the following special folders (not all are available to all flavors of Windows)
' AllUsersDesktop
' AllUsersStartMenu
' AllUsersPrograms
' AllUsersStartup
' Desktop
' Favorites
' Fonts
' MyDocuments
' NetHood
' PrintHood
' Programs
' Recent
' SendTo
' StartMenu
' Startup
' Templates
'Returns:
'strMyPath : The full path to the special folder returns NULL if the folder is not available.
'-------------------------------------------------------------------------------------------------------
'wsh.echo CreateObject("Wscript.Shell").SpecialFolders("AllUsersStartup")
'List all special folders:
'For Each strFolder In WScript.CreateObject("Wscript.Shell").SpecialFolders
' sp = sp & strFolder & vbcrlf
'Next
'wsh.echo sp
'wscript.quit
'-------------------------------------------------------------------------------------------------------
' RunBox [Shell:common startup] ==> [AllUsersStartup] ==> Need Admin Rights, So we must call this vbscript
' With Admin Rights and we must call this sub RunAsAdmin() in the beginning of this vbscript.
' RunBox [Shell:startup] ==> [Startup] we don't need admin rights
'-------------------------------------------------------------------------------------------------------
Option Explicit
Const Title = "Create a shortcut for the current vbscript or any other application with arguments using an array"
Call RunAsAdmin()
Create_Shortcut Array(_
"AllUsersStartup",_
"NetworkDiagnostics",_
"%SystemRoot%\system32\msdt.exe",_
"-skip TRUE -path %Windir%\diagnostics\system\networking -ep NetworkDiagnosticsPNI",_
"%SystemRoot%\system32\msdt.exe,0",_
"Network Diagnostics to fix connections problems",_
"CTRL+ALT+D"_
)
'-------------------------------------------------------------------------------------------------------
Sub Create_Shortcut(rArgs)
Dim objShell,objShortCut,ObjShortcutPath,ShortcutName,ShortcutPath,ShortcutLocation
Dim TargetPath,Arguments,IconLocation,Description,HotKey
Set objShell = CreateObject("WScript.Shell")
If UBound(rArgs) > 1 Then
ShortcutLocation = cstr(rArgs(0))
ShortcutPath = objShell.SpecialFolders(ShortcutLocation)
ShortcutName = cstr(rArgs(1))
Set objShortCut = objShell.CreateShortcut(ShortcutPath & "\" & ShortcutName & ".lnk")
TargetPath = cstr(rArgs(2))
objShortCut.TargetPath = chr(34) & TargetPath & chr(34)
If ShortcutPath = "" Then
MsgBox "Error The Shortcut Path Does Not Exsists On Your System."_
,vbCritical+vbSystemModal,Title
wscript.quit(1)
End If
End If
If UBound(rArgs) > 2 Then
Arguments = cstr(rArgs(3))
objShortCut.Arguments = Arguments
End If
If UBound(rArgs) > 3 Then
IconLocation = cstr(rArgs(4))
ObjShortCut.IconLocation = IconLocation
End If
If UBound(rArgs) > 4 Then
Description = cstr(rArgs(5))
ObjShortCut.Description = Description
End If
If UBound(rArgs) > 5 Then
HotKey = cstr(rArgs(6))
ObjShortCut.HotKey = HotKey
End If
objShortCut.Save
On Error Resume Next
If Err.Number <> 0 Then
ShowError()
Else
MsgBox "The Shortcut "& chr(34) & ShortcutName & chr(34) &" is created Successfully !"& vbcrlf &_
" On " & chr(34) & ShortcutPath & chr(34),vbInformation+vbSystemModal,Title
End If
End Sub
'-------------------------------------------------------------------------------------------------------
Sub ShowError()
ErrDetail = "Description : " & Err.Description & vbCrlf & _
"Error number : " & Err.Number & vbCrlf & _
"Error source : " & Err.Source
MsgBox ErrDetail,vbCritical+vbSystemModal,Title
Err.clear
End Sub
'-------------------------------------------------------------------------------------------------------
Sub RunAsAdmin()
If Not WScript.Arguments.Named.Exists("elevate") Then
CreateObject("Shell.Application").ShellExecute WScript.FullName _
, chr(34) & WScript.ScriptFullName & chr(34) & " /elevate", "", "runas", 1
WScript.Quit
End If
End Sub
'-------------------------------------------------------------------------------------------------------
My Question : Is there anything to improve on this vbscript and avoid any bad practises ?
Thank you !