strTitle="定时关机程序"
Set WshShell=CreateObject("Wscript.NetWork")
strUserName=WshShell.UserName
Set WshShell=CreateObject("Wscript.Shell")
strAnswer=WshShell.Popup(strUserName&" 你好,是否使用自动定时关机?",,strTitle,vbQuestion+vbYesNo)
If strAnswer<>vbYes Then Wscript.Quit
strTime=InputBox ("请输入关机时间!"&vbCrLf&"24小时格式(00:00~23:59之间)"&vbCrLf&"如:2:03 , 22:35",strTitle,"23:00")
Do While Not CheckTime(strTime)
If strTime<>"" Then
WshShell.Popup "时间格式错误,请重新输入",,strTitle,vbCritical
strTime=InputBox ("请输入关机时间!"&vbCrLf&"24小时格式(00:00~23:59之间)"&vbCrLf&"如:2:03 , 22:35",strTitle,"23:00")
Else
Wscript.Quit
End If
Loop
WshShell.Popup "系统将在"&strTime&"关机!!",5,strTitle,vbExclamation
Do
If Hour(strTime)=Hour(Now) And Minute(strTime)=Minute(Now) Then WshShell.Run "shutdown /f /s /t 0":Wscript.Quit
Wscript.Sleep 500
Loop
Set WshShell=CreateObject("Wscript.NetWork")
strUserName=WshShell.UserName
Set WshShell=CreateObject("Wscript.Shell")
strAnswer=WshShell.Popup(strUserName&" 你好,是否使用自动定时关机?",,strTitle,vbQuestion+vbYesNo)
If strAnswer<>vbYes Then Wscript.Quit
strTime=InputBox ("请输入关机时间!"&vbCrLf&"24小时格式(00:00~23:59之间)"&vbCrLf&"如:2:03 , 22:35",strTitle,"23:00")
Do While Not CheckTime(strTime)
If strTime<>"" Then
WshShell.Popup "时间格式错误,请重新输入",,strTitle,vbCritical
strTime=InputBox ("请输入关机时间!"&vbCrLf&"24小时格式(00:00~23:59之间)"&vbCrLf&"如:2:03 , 22:35",strTitle,"23:00")
Else
Wscript.Quit
End If
Loop
WshShell.Popup "系统将在"&strTime&"关机!!",5,strTitle,vbExclamation
Do
If Hour(strTime)=Hour(Now) And Minute(strTime)=Minute(Now) Then WshShell.Run "shutdown /f /s /t 0":Wscript.Quit
Wscript.Sleep 500
Loop
'======================================
Function CheckTime(strTime)
'检查时间格式
On Error Resume Next
If InStr(strTime,":")>0 Then
strTimeParts=Split(strTime,":")
If Cint(strTimeParts(0))>23 Or Cint(strTimeParts(0))<0 Then CheckTime=False : Exit Function
If Cint(strTimeParts(1))>59 Or Cint(strTimeParts(1))<0 Then CheckTime=False : Exit Function
If Len(strTimeParts(0))>2 Or Len(strTimeParts(1))>2 Then CheckTime=False : Exit Function
Else
CheckTime=False : Exit Function
End If
CheckTime=True
End Function
Function CheckTime(strTime)
'检查时间格式
On Error Resume Next
If InStr(strTime,":")>0 Then
strTimeParts=Split(strTime,":")
If Cint(strTimeParts(0))>23 Or Cint(strTimeParts(0))<0 Then CheckTime=False : Exit Function
If Cint(strTimeParts(1))>59 Or Cint(strTimeParts(1))<0 Then CheckTime=False : Exit Function
If Len(strTimeParts(0))>2 Or Len(strTimeParts(1))>2 Then CheckTime=False : Exit Function
Else
CheckTime=False : Exit Function
End If
CheckTime=True
End Function
转载于:https://blog.51cto.com/officevba/243581