vbscript not creating shortcut in context of larger script - vbscript

I'm new to scripting and am taking a class wherein I have been tasked to create a script that places a shortcut on a user's desktop that shuts down the computer. When the shortcut icon is double-clicked the user is asked if they really want to shut down, and given the option to proceed or cancel.
So here's my problem. The script will create the file that the shortcut needs to be linked to, but it won't actually place a shortcut for it on the desktop. However, if I run just the "create shortcut" script by itself, the shortcut is created correctly and everything runs. I don't know what I'm doing wrong and I can't find anything in my text book to help me. I've been working on this for days. I've attached the script. Thanks for your help!
Option Explicit
On Error Resume Next
Dim fsoObject, open_File, target_File, wshObject, myShortcut
set fsoObject = WScript.CreateObject("Scripting.FileSystemObject")
target_File = "C:\Scripts\ShutdownShortcut.vbs"
Open_Shortcut_File()
open_File.WriteLine "Option Explicit"
open_File.WriteLine "On Error Resume Next"
open_File.WriteLine "Dim shellApp, result"
open_File.WriteLine "Set shellApp = CreateObject(""Shell.Application"")"
open_File.WriteLine "result = MsgBox (""Do you wish to shut down your computer?"", vbYesNo)"
open_File.WriteLine "Select Case result"
open_File.WriteLine " Case vbYes"
open_File.WriteLine " MsgBox(""The system will now shut down ..."")"
open_File.WriteLine " Dim objShell"
open_File.WriteLine " Set objShell = WScript.CreateObject(""WScript.Shell"")"
open_File.WriteLine " objShell.Run ""C:WINDOWS\system32\shutdown.exe -r -t 10"""
open_File.WriteLine " Case vbNo"
open_File.WriteLine " MsgBox(""Shutdown cancelled."")"
open_File.WriteLine "End Select"
Close_Shortcut_File()
Function Open_Shortcut_File()
Set open_File = fsoObject.OpenTextFile(target_File, 2, "True")
End Function
Function Close_Shortcut_File()
open_File.Close()
End Function
Set wshObject = WScript.CreateObject("WScript.Shell")
desktopFolder = wshObject.SpecialFolders("Desktop")
Set myShortcut = wshObject.CreateShortcut(desktopFolder & "\\Shutdown.lnk")
myShortcut.TargetPath = target_File
myShortcut.Save

Related

VBSript Shutdown Message Confusion

I am currently learning how to write commands in Visual Basic and decided to make a simple shutdown message. The code worked perfectly: when the user clicked 'yes' it shutdown and 'no', 'cancel' and the 'X' button closed the message.
However, I decided to try a make a prank message aswell, where the computer would shutdown whatever option was chosen. I ran the script, however when I clicked the 'X' icon (I did not fancy the idea of shutting down my computer!), my computer shutdown anyway :(
Is there a way to stop this happening, or, even better, is there a way to grey out the 'X' icon so the user cannot close the message?
Here is the code:
Option Explicit
Dim result
result = MsgBox ("Do you want to shutdown?", 3+48,"Warning")
Dim objShell
Select Case result
Case vbYes
MsgBox("shuting down ...")
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 20"
Case vbNo
MsgBox("shuting down ...")
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 20"
Case vbCancel
MsgBox("shuting down ...")
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 20"
End Select
Cheers in advance! :D
-r : for reboot
-s : for shutdown
This Vbscript can create a shortcut on your desktop asking you if you want to shutdown the computer or not.
Option Explicit
Dim MyScriptPath
MyScriptPath = WScript.ScriptFullName
Call Shortcut(MyScriptPath,"Shutdown the computer")
Call AskQuestion()
'**********************************************************************************************
Sub Shortcut(PathApplication,Name)
Dim objShell,DesktopPath,objShortCut,MyTab
Set objShell = CreateObject("WScript.Shell")
MyTab = Split(PathApplication,"\")
If Name = "" Then
Name = MyTab(UBound(MyTab))
End if
DesktopPath = objShell.SpecialFolders("Desktop")
Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & Name & ".lnk")
objShortCut.TargetPath = Dblquote(PathApplication)
ObjShortCut.IconLocation = "%SystemRoot%\system32\SHELL32.dll,-28"
objShortCut.Save
End Sub
'**********************************************************************************************
Sub AskQuestion()
Dim Question,Msg,Title
Title = "Shutdown the computer"
Msg = "Are you sure to shutdown the computer now ?"& Vbcr &_
"If yes, then click [YES] button "& Vbcr &_
"If not, then click [NO] button"
Question = MsgBox (Msg,VbYesNo+VbQuestion,Title)
If Question = VbYes then
Call Run_Shutdown(30)
else
WScript.Quit()
End if
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Run_Shutdown(N)
Dim ws,Command,Execution
Set ws = CreateObject("wscript.Shell")
Command = "Cmd /c Shutdown -s -t "& N &" -c "& DblQuote("Save your work because your PC will shut down in "& N &" seconds")
Execution = ws.run(Command,0,True)
End sub
'**********************************************************************************************
Ok, is there a reason for trying to remove/disable the X? I ask because it will be kinda difficult though it can be done.
Not all button combinations on the msgbox enable the X. Try vbAbortRetryIgnore and also try vbYesNo.
If a Cancel button is provided (all other combinations except vbOkOnly) then X is enabled
If only one button is displayed then X is enabled
This really makes it almost pointless to disable the button once you are aware of these things. Here's what happens when the above scenarios are displayed an user hits X vs clicking on a button
N/A. X button not enabled
MsgBox returns vbCancel
MsgBox returns value of only button
By the way, it is not just clicking X. When X is enabled, ESC will trigger same results.

VBScript: Getting desktop shortcuts to perform special actions

Truth: I am completely new to this scripting thing and have reached an end-pass. I am trying to write a script that will not only create a shortcut on the user's desktop, but when the user clicks on the icon, I want them to be asked if they really want to shut down the computer and given the option to cancel the shutdown or proceed with the shutdown. So far I have searched to the end of my textbook and google. I can achieve creating an icon and having it perform a Windows native shutdown but not with my special intervening actions. I just don't know how to make the icon call back into the script for the select case routine... Sorry if it is a bit messy See below:
result = MsgBox ("Would you really like to Shutdown?", vbYesNo, "Shutdown?")
Set Shell = CreateObject("WScript.Shell")
DesktopPath = Shell.SpecialFolders("Desktop")
' Add Shutdown link to the desktop
Set linkShutdown = Shell.CreateShortcut(DesktopPath & "\Shutdown.lnk")
linkShutdown.Description = "Shutdown the computer"
linkShutdown.IconLocation = ("%SystemRoot%\system32\SHELL32.dll,27")
linkShutdown.TargetPath = "shutdown"
linkShutdown.WindowStyle = 1
linkShutdown.WorkingDirectory = "%windir%"
linkShutdown.Save
Select Case result
Case vbYes
MsgBox("Shutting down ...")
Dim objShell
Set objShell = WScript.CreateObject("WScript.Shell")
objShell.Run "C:\WINDOWS\system32\shutdown.exe -r -t 0"
Case vbNo
MsgBox("Ok")
End Select
Try this Vbscript : Ask2Shutdown.vbs
Option Explicit
Dim MyScriptPath
MyScriptPath = WScript.ScriptFullName
Call Shortcut(MyScriptPath,"Shutdown the computer")
Call AskQuestion()
'**********************************************************************************************
Sub Shortcut(PathApplication,Name)
Dim objShell,DesktopPath,objShortCut,MyTab
Set objShell = CreateObject("WScript.Shell")
MyTab = Split(PathApplication,"\")
If Name = "" Then
Name = MyTab(UBound(MyTab))
End if
DesktopPath = objShell.SpecialFolders("Desktop")
Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & Name & ".lnk")
objShortCut.TargetPath = Dblquote(PathApplication)
ObjShortCut.IconLocation = "%SystemRoot%\system32\SHELL32.dll,-28"
objShortCut.Save
End Sub
'**********************************************************************************************
Sub AskQuestion()
Dim Question,Msg,Title
Title = "Shutdown the computer"
Msg = "Are you sure to shutdown the computer now ?"& Vbcr &_
"If yes, then click [YES] button "& Vbcr &_
"If not, then click [NO] button"
Question = MsgBox (Msg,VbYesNo+VbQuestion,Title)
If Question = VbYes then
Call Run_Shutdown(30)
else
WScript.Quit()
End if
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Run_Shutdown(N)
Dim ws,Command,Execution
Set ws = CreateObject("wscript.Shell")
Command = "Cmd /c Shutdown -s -t "& N &" -c "& DblQuote("Save your work because your PC will shut down in "& N &" seconds")
Execution = ws.run(Command,0,True)
End sub
'**********************************************************************************************
Set x = CreateObject("Shell.Application")
x.ShutdownWindows
Gives you the Windows' Shutdown dialog.
You have two scripts in one file that you run sequentally. Put them into two files.

Create a shortcut on the desktop that prompts before shutdown

I need to create a shortcut in which I can be prompted if I would like to shut down windows (Action to shutdown when clicking ok). Any ideas?
So far the working shutdown shortcut that I have does not issue the prompt a message asking if I truly want to shutdown or cancel the shortcut request.
Here it is:
Dim shellApp, answer
'Creates Shortcut with a Path to the desktop.
Set Shell = CreateObject("WScript.Shell")
DesktopPath = Shell.SpecialFolders("Desktop")
'Establishes and names the shortcut "Shutdown".
Set linkShutdown = Shell.CreateShortcut(DesktopPath & "\Shutdown.lnk")
'Adds shutdown code to the shortcut.
linkShutdown.Arguments = "-s -t 01"
'Adds Description to shortcut that displays message on link over.
linkShutdown.Description = "Shutdown this Computer"
'Creates Icon for shortcut using system shutdown icon.
linkShutdown.IconLocation = ("%SystemRoot%\system32\SHELL32.dll,27")
'Retrieves shutdown target path for shortcut.
linkShutdown.TargetPath = "shutdown"
'Saves the Script.
linkShutdown.Save
'Prompts the user if they want to shutdown their computer,
'displays ok and cancel buttons for the user to choose.
Set shellApp = CreateObject("Shell.Application")
answer = MsgBox("Do you really want to shut down the computer?", 1, _
"Turn off Computer Script!")
If answer = 1 then
Initiate_Logoff()
End if
'Function that shuts computer down.
Function Initiate_Logoff()
'Adds shutdown code to the shortcut.
End Function
Try this code :
Option Explicit
Dim MyScriptPath
MyScriptPath = WScript.ScriptFullName
Call Shortcut(MyScriptPath,"Shutdown the computer")
Call AskQuestion()
'**********************************************************************************************
Sub Shortcut(PathApplication,Name)
Dim objShell,DesktopPath,objShortCut,MyTab
Set objShell = CreateObject("WScript.Shell")
MyTab = Split(PathApplication,"\")
If Name = "" Then
Name = MyTab(UBound(MyTab))
End if
DesktopPath = objShell.SpecialFolders("Desktop")
Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & Name & ".lnk")
objShortCut.TargetPath = Dblquote(PathApplication)
ObjShortCut.IconLocation = "%SystemRoot%\system32\SHELL32.dll,-28"
objShortCut.Save
End Sub
'**********************************************************************************************
Sub AskQuestion()
Dim Question,Msg,Title
Title = "Shutdown the computer"
Msg = "Are you sure to shutdown the computer now ?"& Vbcr &_
"If yes, then click [YES] button "& Vbcr &_
"If not, then click [NO] button"
Question = MsgBox (Msg,VbYesNo+VbQuestion,Title)
If Question = VbYes then
Call Run_Shutdown(30)
else
WScript.Quit()
End if
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Run_Shutdown(N)
Dim ws,Command,Execution
Set ws = CreateObject("wscript.Shell")
Command = "Cmd /c Shutdown -s -t "& N &" -c "& DblQuote("Save your work because your PC will shut down in "& N &" seconds")
Execution = ws.run(Command,0,True)
End sub
'**********************************************************************************************

VB Script to Delete Desktop shortcut

I need help with this script. This script creates a new desktop shortcut and then deletes another one. However I want it to delete one desktop shortcut if it exists or another if it exists. Not sure how to do this. I've put the 2 different shortcuts in after the "fso.deletefile" but I'm not sure what syntax to use (how to word it.) I'm new to vbs. Thanks in advance for the help.
L_Welcome_MsgBox_Message_Text = "A shortcut to the PM Master" & vbcrlf & "will be created on your desktop."
L_Welcome_MsgBox_Title_Text ="Windows Scripting Host Sample"
Call Welcome()
Dim WSHShell
Set WSHShell =CreateObject("WScript.Shell")
Dim MyShortcut, MyDesktop, DesktopPath
' Read desktop path using WshSpecialFolders object
DesktopPath =WSHShell.SpecialFolders("Desktop")
' Create a shortcut object on the desktop
Set MyShortcut =WSHShell.CreateShortcut(DesktopPath & "\PM-Master-ALL.lnk")
' Set shortcut object properties and save it
MyShortcut.TargetPath =WSHShell.ExpandEnvironmentStrings( "c:\Local Cloud\Shared\Sites\Bailey Lane\PM-Master-ALL")
MyShortcut.Save
Set Shell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
DesktopPath = Shell.SpecialFolders("Desktop")
FSO.DeleteFile DesktopPath & "\PM Master - ALL.lnk"
FSO.DeleteFile DesktopPath & "\PM Master - ALL - Shortcut.lnk"
WScript.Echo "A shortcut to the PM Master has been successfully created. The older PM Master shortcut has been deleted."
Sub Welcome()
Dim intDoIt
intDoIt = MsgBox(L_Welcome_MsgBox_Message_Text, vbOKCancel + vbInformation, L_Welcome_MsgBox_Title_Text )
If intDoIt = vbCancel Then
WScript.Quit
End If
End Sub
When in doubt, read the documentation. You can use the FileExists method to check whether a file exists before attempting to delete it:
shortcut = DesktopPath & "\PM Master - ALL.lnk"
If FSO.FileExists(shortcut) Then FSO.DeleteFile shortcut

File Folder copy

Below is the VBScript code. If the file/s or folder exist I get scripting error, "File already exists".
How to fix that?
How to create folder only if it does not exist and copy files only that are new or do not exist in source path?
How to insert the username (Point 1) after "Welcome" and at (Poin 3) instead of user cancelled?
Can the buttons be changed to Copy,Update,Cancel instead of Yes,No,Cancel? (Point 2)
The code:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
Message = " Welcome to the AVG Update Module" & vbCR '1*
Message = Message & " *****************************" & vbCR & vbCR
Message = Message & " Click Yes to Copy Definition Files" & vbCR & vbCR
Message = Message & " OR " & vbCR & vbCR
Message = Message & " Click No to Update Definition Files." & vbCR & vbCR
Message = Message & " Click Cancel (ESC) to Exit." & vbCR & vbCR
X = MsgBox(Message, vbYesNoCancel, "AVG Update Module") '2*
'Yes Selected Script
If X = 6 then
objFSO.FolderExists("E:\Updates")
if TRUE then objFSO.CreateFolder ("E:\Updates")
objFSO.CopyFile "c:\Docume~1\alluse~1\applic~1\avg8\update\download\*.*",
"E:\Updates\" , OverwriteFiles
MsgBox "Files Copied Succesfully.", vbInformation, "Copy Success"
End If
'No Selected Script
If X = 7 then
objFSO.FolderExists("Updates")
if TRUE then objFSO.CreateFolder("Updates")
objFSO.CopyFile "E:\Updates\*.*", "Updates", OverwriteFiles
Message = "Files Updated Successfully." & vbCR & vbCR
Message = Message & "Click OK to Launch AVG GUI." & vbCR & vbCR
Message = Message & "Click Cancel (ESC) to Exit." & vbCR & vbCR
Y = MsgBox(Message, vbOKCancel, "Update Success")
If Y = 1 then
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run chr(34) & "C:\Progra~1\avg\avg8\avgui.exe" & Chr(34), 0
Set WshShell = Nothing
End if
If Y = 3 then WScript.Quit
End IF
'Cancel Selection Script
If X = 2 then
MsgBox "No Files have been Copied/Updated.", vbExclamation, "User Cancelled" '3*
End if
How to create folder only if it does not exist
This your code:
objFSO.FolderExists("E:\Updates")
if TRUE then objFSO.CreateFolder ("E:\Updates")
simply calls the FolderExists and CreateFolder methods in sequence (CreateFolder is always called because the if TRUE condition evaluates to True) and is equal to:
objFSO.FolderExists("E:\Updates")
objFSO.CreateFolder ("E:\Updates")
You want to call CreateFolder depending on the return value of the FolderExists method:
If Not objFSO.FolderExists("E:\Updates") Then
objFSO.CreateFolder "E:\Updates"
and copy files only that are new or do not exist in source path?
Neither VBScript nor the FileSystemObject object have this functionality. However, it is possible to call an external tool that can do that, such as xcopy, from your script using the WshShell.Run method. I guess you need something like this:
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "xcopy c:\Docume~1\alluse~1\applic~1\avg8\update\download\*.* E:\Updates\ /D", , True
How to insert the username (Point 1)
Concatenate the message text with the strUserName variable value:
Message = " Welcome " & strUserName & " to the AVG Update Module" & vbCR
...
MsgBox "No Files have been Copied/Updated.", vbExclamation, strUserName & " Cancelled"
Can the buttons be changed to Copy,Update,Cancel Instead of Yes,No,Cancel?(Point 2)
No, VBScript's built-in MsgBox function does not support custom buttons. There're workarounds though: you could create your custom message box using an HTA (HTML application) or use the InputBox function to prompt the user for the task they wish to perform. You can find examples here.
I'd also like to note that you can improve your script by using the Select Case statement to check the MsgBox return value instead of multiple If...Then...End If statements. Also, it's a bad practice to use "magic numbers" like 6 or 7 - use the appropriate constants instead. For example:
Select Case X
Case vbYes
...
Case vbNo
...
Case Else ' vbCancel
...
End Select
When you say
"copy files only that are new or do
not exist in source path?"
do you mean you only want to copy files from the source directory to the destination directory if they do not exist in the destination? If so this will accomplish that
Const SourceFolder = "C:\Test1\"
Const DestinationFolder = "C:\Test2\"
Set fso = CreateObject("Scripting.FileSystemObject")
'Get a collection of al the files in the source directory
Set fileCol = fso.GetFolder(SourceFolder).Files
'Loop through each file and check to see if it exists in the destination directory
For Each objFile in fileCol
If NOT fso.FileExists(DestinationFolder & objFile.Name) Then
'If the file does not exist in the destination directory copy it there.
objFile.Copy DestinationFolder
Else
If objFile.DateLastModified > fso.GetFile(DestinationFolder & objFile.Name).DateLastModified Then
'If the file is newer than the destination file copy it there
objFile.Copy DestinationFolder, True
End If
End If
Next
Set fileCol = Nothing
Set fso = Nothing
Added the requested date check.

Resources