0
\$\begingroup\$

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 !

\$\endgroup\$

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.