1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
| Option Explicit
Const Title = "Create a shortcut for the current vbscript or any other application with arguments using an array"
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"_
)
'-------------------------------------------------------------------------------------------------------
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 = objShell.ExpandEnvironmentStrings(rArgs(2))
objShortCut.TargetPath = TargetPath
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
objShell.Popup "The Shortcut "& chr(34) & ShortcutName & chr(34) &" is created Successfully !"& vbcrlf &_
"On " & chr(34) & ShortcutPath & chr(34),5,Title,vbInformation+vbSystemModal
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
'------------------------------------------------------------------------------------------------------- |
Partager