Help! We are rolling out Windows 7 64 bit. I am looking for a program to shutdown computers at 4:00 BUT will give the user an option to cancel if they are still working.

Our windows XP machines currently have poweroff.exe pushed it them and are giving the option to cancel but the pop-up does not display now in Windows 7 64 bit. Upon researching it has to do with windows 7 64 bit session id. being used. ??

I have also tried pstools (psexec and psshutdown) and windows own shutdown.exe to no avail.

Any help on finding software to that will work with Win7 64-bit computers WITH the option to cancel would be appreciated.

Thank you in advance!
0 Comments   [ + ] Show Comments

Comments

Please log in to comment

Rating comments in this legacy AppDeploy message board thread won't reorder them,
so that the conversation will remain readable.

Answers

0
Have you properly checked out Win7's Task Scheduler features. Whilst there isn't prompts per se you can postpopne tasks if there is activity at the computer and reschedule them to try again at a later interval.
Answered 09/26/2011 by: squeakstar
Orange Senior Belt

Please log in to comment
0
Here's a QAD HTA I built for a client<!DOCTYPE HTML PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd>
<HTML xmlns:yCode>
<HEAD>
<TITLE>
Scheduled shutdown
</TITLE>

<HTA:APPLICATION
ID = "DoShutdown"
APPLICATIONNAME = "DoShutdown"
BORDER = "None"
BORDERSTYLE = "Normal"
CAPTION = "Yes"
CONTEXTMENU = "No"
ICON = "DoShutdown.ico"
INNERBORDER = "Yes"
MAXIMIZEBUTTON = "No"
MINIMIZEBUTTON = "No"
NAVIGABLE = "No"
SCROLL = "No"
SCROLLFLAT = "Yes"
SELECTION = "No"
SHOWINTASKBAR = "Yes"
SINGLEINSTANCE = "Yes"
SYSMENU = "No"
VERSION = "1.0"
WINDOWSTATE = "Normal"
>

<STYLE>
HTML, BODY
{
background-image: url("DoShutdownClientBackground.jpg");
background-color: #FFCC00;
margin: 0;
padding: 0;
line-height: 1.5em;
font-size: 87%;
font-family: Verdana, Arial, Helvetica, sans-serif;
}

#top_body
{
clear: both;
margin: 20px 0 0 0;
text-align: center;
}

#top_body p
{
margin: 20px 0 0 0;
font-style: italic;
}

H1
{
color:#FF0000;
font-weight: bold;
text-transform: uppercase;
font-family: "Arial Narrow", Arial, Helvetica, sans-serif;
font-size: 3em; margin: 0 15px 0 0;
letter-spacing: -.05em;
}

H2
{
color: #4e4a4e;
font-weight: bold;
font-size: 1.4em;
margin: 15px 0 0 0;
}

INPUT
{
font-family: tahoma;
font-size: 18pt;
}
</STYLE>

<SCRIPT LANGUAGE="VBScript">
Public intReturn
Public objFSO
Public objWSHShell
Public objWSHShellApp
Public strDummy
Public strArgument
Public blnArgumentsAreValid
Public strHTA
Public strHTAPath
Public strAppRootFolder
Public strCommandLine
Public dicArguments
Public intSlashPos
Public intHTANamePos
Public intSpacePos
Public strHours
Public strMinutes
Public strSeconds
Public datCountdownStartedTime
Public datExecutionTime
Public datCurrentTime
Public datRemainingTime
Public strCountdownStartedTime
Public strExecutionTime
Public strCurrentTime
Public strRemainingTime
Public intHours
Public intMinutes
Public intSeconds
Public intTimerID
Public strRestartType
Public strHeaderText
Public strRestartText

Const intWindowWidth = 550
Const intWindowHeight = 410

Const WMI_Shutdown_LogOff = 0
Const WMI_Shutdown_Forced = 4
Const WMI_Shutdown_PowerOff = 8
Const WMI_Shutdown_Reboot = 2
Const WMI_Shutdown_Shutdown = 1

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSHShell = CreateObject("WScript.Shell")
Set objWSHShellApp = CreateObject("Shell.Application")
Set dicArguments = CreateObject("Scripting.Dictionary")

dicArguments.CompareMode = vbTextcompare '// Set case insensitivity for arguments

'// Set default timeout for 5 minutes
intHours = 0
intMinutes = 5
intSeconds = 0

'// Set default shutdown type
strRestartType = "RF"
intShutdownFlag = WMI_Shutdown_RebootForced
strRestartText = "restarted"
strHeaderText = "Scheduled restart"

Sub Window_Onload
Dim blnShow
Dim blnMiniseAllOpenWindows
Dim objFileHTA
Dim blnResult_Window
Dim intCountColon
Dim intCountSpace

strCommandLine = Trim(DoShutdown.CommandLine)
blnMiniseAllOpenWindows = True

'// Ditch the stupid quotes which MS has decreed will surround the name
'// even when there are no spaces in ANY folder name!
strCommandLine = Replace(strCommandLine, Chr(34), "")

'// Bizarrely, if an argument is passed to an HTA and we remove the quote marks,
'// we get an extra space character!
If InStr(strCommandLine, " ") > 0 Then
strCommandLine = Replace(strCommandLine, " ", " ")
End If

Call ParseArguments
Call AssignAndValidateArguments

If Not blnArgumentsAreValid Then
ExitScript
End If

Call ResizeWindow(intWindowWidth, intWindowHeight, blnShow)
Call CentreWindow(intWindowWidth, intWindowHeight, blnShow)

spanHeader.InnerText = strHeaderText
spanRestartText.InnerText = strRestartText
spanCountdownStartedPrompt.InnerText = "Countdown Started:"
spanExecutionTimePrompt.InnerText = "Execution Time:"
spanCurrentTimePrompt.InnerText = "Current Time:"
spanRemainingTimePrompt.InnerText = "Remaining Time:"

Call CalculateTimeout
Call CheckCountdown(blnMiniseAllOpenWindows, intHours,intMinutes,intSeconds)
End Sub

Sub ParseArguments
Dim blnResult_Parse
Dim arrAllArguments
Dim strAllArguments
Dim arrArgument
Dim strArgument
Dim intArgumentPos

On Error Resume Next

With document
strDummy = .url
strHTA = Mid(strDummy, Len("file://" ) + 1 )
strHTAPath = objFSO.GetParentFolderName(strDummy)
End With

intArgumentPos = InStr(strCommandLine, "/")

If intArgumentPos = 0 Then
Exit Sub
End If

strAllArguments = Trim(Split(strCommandLine, strHTA)(1))
arrAllArguments = Split(strAllArguments, " ")

For Each strArgument In arrAllArguments
arrArgument = Split(strArgument, "=", 2)

'/ If value is specified multiple times, last one wins
If dicArguments.Exists(Trim(arrArgument(0))) Then
dicArguments.Remove(Trim(arrArgument(0)))
End If

If UBound(arrArgument) >= 1 Then
dicArguments.Add Trim(arrArgument(0)), Trim(arrArgument(1))
Else
dicArguments.Add Trim(arrArgument(0)),""
End If
Next

On Error Goto 0
End Sub

Sub AssignAndValidateArguments
Dim intCountColon
Dim intCountSpace
Dim strAction
Dim strCountdownTime
Dim blnForce

blnArgumentsAreValid = False

'// Check for -help, -? etc help request on command line
If (dicArguments.Count < 1) Or (dicArguments.Exists("help")) or (dicArguments.Exists("/help")) or (dicArguments.Exists("?")) or (dicArguments.Exists("/?")) Then
strDummy = "Command line switches for this application are:"
strDummy = strDummy & vbCRLF & vbCRLF
strDummy = strDummy & vbTAB & "/T=hh:mm:ss" & vbTAB & "Sets the number of hours, minutes and seconds to countdown before shutdown/restart occurs."
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & vbTAB & vbTAB & "Use hh:mm:ss format."
strDummy = strDummy & vbCRLF & vbCRLF
strDummy = strDummy & vbTAB & "/A=x" & vbTAB & vbTAB & "Sets the action to take."
strDummy = strDummy & " Valid options for 'x' are:"
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & vbTAB & vbTAB & vbTAB & "L" & vbTAB & "- log the user off"
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & vbTAB & vbTAB & vbTAB & "P" & vbTAB & "- power-off the machine"
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & vbTAB & vbTAB & vbTAB & "R" & vbTAB & "- restart the machine"
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & vbTAB & vbTAB & vbTAB & "S" & vbTAB & "- shutdown the machine"
strDummy = strDummy & vbCRLF
strDummy = strDummy & vbTAB & "/F" & vbTAB & vbTAB & "Forces the action."
strDummy = strDummy & vbCRLF

MsgBox strDummy,vbOKOnly
Exit Sub
End If

strAction = dicArguments("/A")
strCountdownTime = dicArguments("/T")
If dicArguments.Exists("/F") Then
blnForce = True
End If

'// Validate dependencies
If strAction = "" Then
strDummy = "You must specify the '/A' argument."
' MsgBox strDummy,vbOKOnly
' Exit Sub

'// As a default, let's set a restart
strHeaderText = "Scheduled restart"
intShutdownFlag = WMI_Shutdown_Reboot
strRestartText = "restarted"
Else
Select Case strAction
Case "L"
strHeaderText = "Scheduled log-off"
intShutdownFlag = WMI_Shutdown_LogOff
strRestartText = "logged off"
Case "P"
strHeaderText = "Scheduled power-off"
intShutdownFlag = WMI_Shutdown_PowerOff
strRestartText = "powered off"
Case "R"
strHeaderText = "Scheduled restart"
intShutdownFlag = WMI_Shutdown_Reboot
strRestartText = "restarted"
Case "S"
strHeaderText = "Scheduled shut-down"
intShutdownFlag = WMI_Shutdown_Shutdown
strRestartText = "shut down"
End Select

If blnForce Then
intShutdownFlag = intShutdownFlag & WMI_Shutdown_Forced
strRestartText = "forcibly " & strRestartText
End If
End If

If Len(strCountdownTime) > 0 Then
If InStr(strCountdownTime, ":") > 0 Then
blnResult_Parse = GetSubstringCount(":", strCountdownTime, True, intCountColon)

If (intCountColon > 2) Or (intCountColon < 1) Then
'// Twat...
Else
strHours = Split(strCountdownTime, ":")(0)
strMinutes = Split(strCountdownTime, ":")(1)
strSeconds = Split(strCountdownTime, ":")(2)
End If
End If
End If

blnArgumentsAreValid = True
End Sub

Sub CalculateTimeout()
If Len(strHours) > 1 Then
If Left(strHours, 1) = "0" Then
strHours = Right(strHours, 1)
End If
End If
intHours = CInt(strHours)

If Len(strMinutes) > 1 Then
If Left(strMinutes, 1) = "0" Then
strMinutes = Right(strMinutes, 1)
End If
End If
intMinutes = CInt(strMinutes)

If Len(strSeconds) > 1 Then
If Left(strSeconds, 1) = "0" Then
strSeconds = Right(strSeconds, 1)
End If
End If
intSeconds = CInt(strSeconds)
End Sub

Sub CheckCountdown(ByVal blnMinise, ByVal intInHours, ByVal intInMinutes, ByVal intInSeconds)
Dim intHoursToExecutionTime
Dim intMinutesToExecutionTime
Dim intSecondsToExecutionTime

If blnMinise Then
'// Minimise all open windows, to make ours stand out
objWSHShellApp.MinimizeAll
End If

datCountdownStartedTime = Now()

intHoursToExecutionTime = 0
intMinutesToExecutionTime = 0
intSecondsToExecutionTime = 0

If intInHours =0 And intInMinutes = 0 And intInSeconds = 0 Then
intSecondsToExecutionTime = 2
Else
If intInHours > 0 Then
intHoursToExecutionTime = intInHours
End If

If intInMinutes > 0 Then
intMinutesToExecutionTime= (intHoursToExecutionTime * 60) + intInMinutes
Else
intMinutesToExecutionTime= (intHoursToExecutionTime * 60)
End If

intSecondsToExecutionTime = (intMinutesToExecutionTime * 60) + intInSeconds
End If

datExecutionTime = DateAdd("s",intSecondsToExecutionTime, datCountdownStartedTime)

intTimerID = window.setInterval("DoCountdown()", 1000)

End Sub

Sub DoCountdown()

strCountdownStartedTime = DatePart("h", datCountdownStartedTime) & ":"
strCountdownStartedTime = strCountdownStartedTime & Right("00" & DatePart("n", datCountdownStartedTime), 2) & ":"
strCountdownStartedTime = strCountdownStartedTime & Right("00" & DatePart("s", datCountdownStartedTime), 2)

strExecutionTime = DatePart("h", datExecutionTime) & ":"
strExecutionTime = strExecutionTime & Right("00" & DatePart("n", datExecutionTime), 2) & ":"
strExecutionTime = strExecutionTime & Right("00" & DatePart("S", datExecutionTime), 2)

strCurrentTime = DatePart("h", Now()) & ":"
strCurrentTime = strCurrentTime & Right("00" & DatePart("n", Now()), 2) & ":"
strCurrentTime = strCurrentTime & Right("00" & DatePart("s", Now()), 2)

blnResult = CalculateTimeSpan(Now(), datExecutionTime, strRemainingTime)

spanCountdownStarted.InnerText = strCountdownStartedTime
spanExecutionTime.InnerText = strExecutionTime
spanCurrentTime.InnerText = strCurrentTime
spanRemainingTime.InnerText = strRemainingTime

If strRemainingTime = "00:00:00" Then
Call ClearCountdown
Shutdown(intShutdownFlag)
End If
End Sub

Function CalculateTimeSpan(ByVal datFirst, ByVal datSecond, ByRef strTimeSpan)
Dim strSpanHours
Dim strSpanstrSpanMinutes
Dim strSpanSeconds

If (IsDate(datFirst) And IsDate(datSecond)) = False Then
strTimeSpan = "00:00:00"
Exit Function
End If

strSpanSeconds = Abs(DateDiff("S", datFirst, datSecond))
strSpanMinutes = strSpanSeconds \ 60
strSpanHours = strSpanMinutes \ 60
strSpanMinutes = strSpanMinutes mod 60
strSpanSeconds = strSpanSeconds mod 60

If Len(strSpanHours) = 1 Then
strSpanHours = "0" & strSpanHours
End If

strTimeSpan = strSpanHours & ":" & Right("00" & strSpanMinutes, 2) & ":" & Right("00" & strSpanSeconds, 2)
End Function

Sub ClearCountdown
'// Because of most browser's idiotic behaviour with empty table cells,
'// we populate them with spaces

Dim strSpaces

strSpaces = String(4, " ")
spanCountdownStarted.InnerText = strSpaces
spanExecutionTime.InnerText = strSpaces
spanCurrentTime.InnerText = strSpaces
spanRemainingTime.InnerText = strSpaces

window.clearInterval(intTimerID)
End Sub

Sub Shutdown(ByVal intShutdownFlag)
Dim objWMIService

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown )}").InstancesOf("Win32_OperatingSystem")

For Each objSystem In objWMIService
objSystem.Win32Shutdown intShutdownFlag
Next

Set objWMIService = Nothing
End Sub

Sub DoCancel
Window.Close
End Sub

Sub btnQuit_onClick
Call ExitScript
End Sub

Sub ExitScript
'// So that no-one knows we've been, reset the Custom Zone
'objWshShell.RegWrite strIEAccessDataAcrossDomainsLocalRegKey, 1, "REG_DWORD"
'If Err.Number <> 0 Then
' strMsg = "Unable to write IE Security registry value."
' MsgBox strMsg, vbOKonly + vbCritical
'End If

Set dicArguments = Nothing
Set objWSHShellApp = Nothing
Set objWSHShell = Nothing
Set objFSO = Nothing

self.Close
End Sub

Sub HandleKeys
Select Case window.event.keycode
Case 13
Call btnExecute_onClick
Case 27
Call btnQuit_onClick
End Select
End Sub

Sub GetScreenSize(ByRef intHorizontal, ByRef intVertical)
Dim strComputer
Dim objWMIService_GSS
Dim colItems
Dim objItem

strComputer = "."

Set objWMIService_GSS = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService_GSS.ExecQuery("Select * From Win32_DesktopMonitor")

For Each objItem In colItems
intHorizontal = objItem.ScreenWidth
intVertical = objItem.ScreenHeight
Exit For
Next

Set colItems = Nothing
Set objWMIService_GSS = Nothing
End Sub

Sub ResizeWindow(ByVal intWidth, ByVal intHeight, ByVal blnShowMsg)
Dim intH
Dim intV
Dim objMessageAreaResize

With Window
If blnShowMsg Then
Set objMessageAreaResize = .document.getElementById("HeaderArea")
objMessageAreaResize.InnerHTML = "Resizing window"
Set objMessageAreaResize = Nothing
End If

.resizeTo intWidth,intHeight
End With
End Sub

Sub CentreWindow(ByVal intWidth, ByVal intHeight, ByVal blnShowMsg)
Dim intH
Dim intV
Dim intLeft
Dim intTop
Dim objMessageAreaCentre

Call GetScreenSize(intH, intV)

intLeft = (intH - intWidth) / 2
intTop = (intV - intHeight) / 2

With Window
If blnShowMsg Then
Set objMessageAreaCentre = .document.getElementById("HeaderArea")
objMessageAreaCentre.InnerHTML = "Centering window"
Set objMessageAreaCentre = Nothing
End If

.moveTo intLeft, intTop
End With
End Sub

'// =========================================================================================================
'// Name: GetSubstringCount
'// Purpose: Determines how many times one string occurs in another string
'// Input: strToLookFor - the string to look for
'// strSearch - the string to look in
'// blnIgnoreCase - If True, ignore case of both strings
'// Output: intStringCount - a 'ByRef' variable which will contain the number of occurrences
'// Returns: True/False
'// =========================================================================================================
Function GetSubstringCount(ByVal strToLookFor, ByVal strSearch, ByVal blnIgnoreCase, ByRef intStringCount)
'// Since VBS doesn't provide a string counter (i.e. how many times a string occurs in another string)
'// we hack it using Split: the UBound of the array will tell us how many occurrences there are, if any

'// Assume the worst
intStringCount = 0
GetSubstringCount = False

If Len(strToLookFor) = 0 Then
strMsg = "A parameter, 'strToLookFor', passed to " & strScriptName & ".GetSubstringCount is empty."
'errStatus = MsgUsr(strMsg, intButtonType, strScriptName & ".GetSubstringCount", intButtonPressed)
Exit Function
End If

If Len(strSearch) = 0 Then
strMsg = "A parameter, 'strSearch', passed to " & strScriptName & ".GetSubstringCount is empty."
'errStatus = MsgUsr(strMsg, intButtonType, strScriptName & ".GetSubstringCount", intButtonPressed)
Exit Function
End If

If blnIgnoreCase Then
intStringCount = UBound(Split(strSearch, strToLookFor))
Else
intStringCount = UBound(Split(UCase(strSearch), UCase(strToLookFor)))
End If

GetSubstringCount = True

End Function

'//=========================================================================================================
'// Name: StringMatch
'// Purpose: Checks if two strings match
'// Why not use 'If strFirst = strSecond', you're asking?
'// Well, the 'Equals' operator :
'// - is not very fast (at string comparison)!
'// - compares strings left to right and is smart enough to stop comparing when it spots the first difference, but
'// - is too dumb to first do the most obvious test: comparing the lengths of the strings!
'// Input: strFirst - the first string
'// strSecond - the second string
'// blnMatch - a Boolean indicating whether or not the strings matched
'// Output: None
'// Returns: True/False
'//
'//=========================================================================================================
Function StringMatch(ByVal strFirst, ByVal strSecond, ByRef blnMatch)

StringMatch = True

blnMatch = False

If LenB(strFirst) = LenB(strSecond) Then
blnMatch = (InStrB(1, strFirst, strSecond, vbBinaryCompare) <> 0)
End If

End Function
</SCRIPT>
</HEAD>

<BODY onKeyUp='HandleKeys()'>
<DIV ID="pagewidth1">
<DIV ID="top_body">
<P><IMG SRC="DoShutdownClientLogo.gif" /></p>
<P>&nbsp;</P>
<H1><SPAN ID=spanHeader></SPAN></H1>
<P>&nbsp;</P>
</DIV>
</DIV>

<P ALIGN="center">
This computer is scheduled to be <SPAN ID='spanRestartText'></SPAN>.<BR>Please click the 'Cancel' button if you wish to continue using it.
</P>

<TABLE WIDTH='98%' BORDER=0>
<TR>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanCountdownStartedPrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanCountdownStarted'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='5%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanExecutionTimePrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanExecutionTime'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
</TR>

<TR>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanCurrentTimePrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanCurrentTime'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='5%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
<TD WIDTH='30%' ALIGN='RIGHT'>
<FONT SIZE="2">
<SPAN ID='spanRemainingTimePrompt'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='17%' ALIGN='LEFT'>
<FONT SIZE="2">
<SPAN ID='spanRemainingTime'>
</SPAN>
</FONT>
</TD>
<TD WIDTH='1%'>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
</TR>
</TABLE>

<TABLE WIDTH='98%' BORDER=0>
<TR>
<TD>
<FONT SIZE="2">
&nbsp;
</FONT>
</TD>
</TR>

<TR>
<TD ALIGN='CENTER'>
<FONT SIZE="2">
<INPUT ACCESSKEY='Q' CLASS="button" TYPE="button" VALUE="Cancel" ID='btnQuit' NAME='btnQuit'>
</FONT>
</TD>
</TR>
</TABLE>
</BODY>
</HTML>
Answered 09/26/2011 by: VBScab
Red Belt

Please log in to comment
0
Thanks MS for once again screwing the pooch.

I'm about to roll out this simple vbs code I found here while looking for a solution.  Be sure to save it as ANSI or cscript pukes.

'ShutdownTimer.vbs - Shutdown Windows after n minutes.
'Requires Windows 98 or higher, and Windows Script Host 2 or greater.
'© Bill James - bill@billsway.com - rev 26/Oct/2003 15:21

Option Explicit
Dim ws, Title, ErrMsg
Set ws = CreateObject("Wscript.Shell")
Title = "Windows Shutdown Notification"
Dim oWMI, oOS, obj

On Error Resume Next
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\.\root\cimv2")
If Err Then
Call Cleanup
End If
On Error GoTo 0
For Each obj in oWMI.ExecQuery("Select * from Win32_OperatingSystem")
Set oOS = obj
Exit For
Next

ShutDownNow

Sub ShutDownNow()
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const EWX_POWEROFF = 8

'Last chance to abort shutdown.
If ws.Popup("This computer is shutting down in 2 minutes (" & TimeValue(DateAdd("n", 1, Now())) & "). Please save your work and exit any programs running." & _
vbcrlf & vbcrlf & "Click Cancel to abort shutdown, click OK to shutdown now.",_
120, Title, 1 + 256 + 48 + 4096) = 2 Then
Call Cleanup
Else
oOS.Win32shutdown EWX_SHUTDOWN + EWX_FORCE
End If
End Sub

Sub Cleanup
Set ws = Nothing
WScript.Quit
End Sub

Answered 02/10/2015 by: pyperdown
Orange Belt

Please log in to comment
Answer this question or Comment on this question for clarity