Loops 长时间运行VBScript文件警报

Loops 长时间运行VBScript文件警报,loops,time,vbscript,do-while,Loops,Time,Vbscript,Do While,我试图构建一个VBScript文件,以提醒我所在学校的教师(一旦他们登录)在需要进行注册时(在本例中,每节课开始15分钟)进行注册 我通过尝试无限循环来实现这一点,并检查何时提醒用户。但是,当运行时,仅当执行时间等于9:00或10:00等时才满足条件。我希望它在后台有效运行,并在时间等于9:00或10:00等时发出警报 代码如下: Do While True If Now() = #09:00# Or Now() >= #10:00# Or Now() >= #11:20#

我试图构建一个VBScript文件,以提醒我所在学校的教师(一旦他们登录)在需要进行注册时(在本例中,每节课开始15分钟)进行注册

我通过尝试无限循环来实现这一点,并检查何时提醒用户。但是,当运行时,仅当执行时间等于9:00或10:00等时才满足条件。我希望它在后台有效运行,并在时间等于9:00或10:00等时发出警报

代码如下:

Do While True
    If Now() = #09:00# Or Now() >= #10:00# Or Now() >= #11:20# Or Now() >= #12:20# Or Now() >= #14:05# Then
        msg = Msgbox ("Have you done your register?",4+48+4096,"")
        If msg = 7 Then
            Msgbox "Please take it immediately.",48+4096,""
            Exit Do
        Else
            Exit Do
        End If
    End If
Loop
我尝试过通过FormatDateTime()和Do-Until循环以不同的方式获取时间,得到了相同的结果

显然,如果我去掉Exit Do语句,它将在这一分钟内永远运行。我希望它每次只提醒一次

请帮忙

有效

我设法更改了脚本,以便读取正确的时间,并且脚本必须等待一分钟才能退出msgbox循环。然后在最后一次阅读时,它显示最后一条消息并结束循环,但是,它仍然会在后台运行,直到用户注销(我认为这不会对资源造成压力)


你应该这样写:

Do While True
    ctime = FormatDateTime(Now(),4)
    If ctime = "09:00" Or ctime = "10:00" Or ctime = "11:20" Or ctime = "12:20" Then
        msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
        If msg = VbNo Then
            Msgbox "Please take it immediately.",48+4096,Now()
            WScript.Sleep 60000
        Else
            WScript.Sleep 60000
        End If
    ElseIf ctime = "14:05" Then
        msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
        If msg = VbNo Then
            Msgbox "Please take it immediately !",48+4096,Now()
            Exit Do
            WScript.Quit
        Else
            Exit Do
            WScript.Quit
        End If
    End If
Loop
我添加了一些有趣的东西,比如被来自网络的警报惊醒,如果你喜欢,就试试吧

Option Explicit
If AppPrevInstance() Then 
    MsgBox "There is an existing proceeding !" & VbCrLF &_
    CommandLineLike(WScript.ScriptName),VbExclamation,"There is an existing proceeding !"    
    WScript.Quit   
Else 
    Dim ctime,msg,Time1,Time2,Time3,Time4,LastTime2GoAway,Alarm
    Time1 = "09:00" : Time2 = "10:00" : Time3 = "11:20" : Time4 = "12:20" : LastTime2GoAway = "14:05"
    Alarm = "http://soundbible.com/1080-Airhorn.html"
    Do While True
        ctime = FormatDateTime(Now(),4)
        If ctime = Time1 Or ctime = Time2 Or ctime = Time3 Or ctime = Time4 Then
            If CheckConnectionInternet() = True Then 
                Call Alert(Alarm)
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately.",48+4096,Now()
                    Call Pause(60)
                Else
                    Call Pause(60)
                End If
            Else    
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately.",48+4096,Now()
                    Call Pause(60)
                Else
                    Call Pause(60)
                End If
            End If
        ElseIf ctime = LastTime2GoAway Then
            If CheckConnectionInternet() = True Then 
                Call Alert(Alarm)
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately !",48+4096,Now()
                    Exit Do
                    WScript.Quit
                Else
                    Exit Do
                    WScript.Quit
                End If
            Else
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately !",48+4096,Now()
                    Exit Do
                    WScript.Quit
                Else
                    Exit Do
                    WScript.Quit
                End If
            End If
        End If
    Loop
End If
'**************************************************************************
Sub Alert(WebSite)
    Dim objExplorer
    Set objExplorer = CreateObject("InternetExplorer.Application")
    objExplorer.Navigate WebSite
    objExplorer.Visible = 0 'Invisible
    Do While (objExplorer.Busy)
        Wscript.Sleep 500
    Loop
    Wscript.Sleep 5000
    objExplorer.Quit
End Sub
'**************************************************************************
Function AppPrevInstance()   
    With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")   
        With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
            " AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
            AppPrevInstance = (.Count > 1)   
        End With   
    End With   
End Function    
'**************************************************************************
Function CommandLineLike(ProcessPath)   
    ProcessPath = Replace(ProcessPath, "\", "\\")   
    CommandLineLike = "'%" & ProcessPath & "%'"   
End Function
'**************************************************************************
Function CheckConnectionInternet()
    Dim strComputer,objPing,objStatus
        strComputer = "smtp.gmail.com"
        Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
        ("select * from Win32_PingStatus where address = '" & strComputer & "'")
        For Each objStatus in objPing
            If objStatus.Statuscode = 0 Then
                CheckConnectionInternet = True
            Else
                CheckConnectionInternet = False
            End If
        Next
End Function
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub
'**************************************************************************************

我建议对您的
MsgBox
参数使用。我不理解这一行“WScript.CreateObject(“WScript.Shell”).Run(path)”????什么路径???加1表示创造性!:)
Option Explicit
If AppPrevInstance() Then 
    MsgBox "There is an existing proceeding !" & VbCrLF &_
    CommandLineLike(WScript.ScriptName),VbExclamation,"There is an existing proceeding !"    
    WScript.Quit   
Else 
    Dim ctime,msg,Time1,Time2,Time3,Time4,LastTime2GoAway,Alarm
    Time1 = "09:00" : Time2 = "10:00" : Time3 = "11:20" : Time4 = "12:20" : LastTime2GoAway = "14:05"
    Alarm = "http://soundbible.com/1080-Airhorn.html"
    Do While True
        ctime = FormatDateTime(Now(),4)
        If ctime = Time1 Or ctime = Time2 Or ctime = Time3 Or ctime = Time4 Then
            If CheckConnectionInternet() = True Then 
                Call Alert(Alarm)
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately.",48+4096,Now()
                    Call Pause(60)
                Else
                    Call Pause(60)
                End If
            Else    
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately.",48+4096,Now()
                    Call Pause(60)
                Else
                    Call Pause(60)
                End If
            End If
        ElseIf ctime = LastTime2GoAway Then
            If CheckConnectionInternet() = True Then 
                Call Alert(Alarm)
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately !",48+4096,Now()
                    Exit Do
                    WScript.Quit
                Else
                    Exit Do
                    WScript.Quit
                End If
            Else
                msg = Msgbox ("Have you done your register ?",4+32+4096,Now())
                If msg = VbNo Then
                    Msgbox "Please take it immediately !",48+4096,Now()
                    Exit Do
                    WScript.Quit
                Else
                    Exit Do
                    WScript.Quit
                End If
            End If
        End If
    Loop
End If
'**************************************************************************
Sub Alert(WebSite)
    Dim objExplorer
    Set objExplorer = CreateObject("InternetExplorer.Application")
    objExplorer.Navigate WebSite
    objExplorer.Visible = 0 'Invisible
    Do While (objExplorer.Busy)
        Wscript.Sleep 500
    Loop
    Wscript.Sleep 5000
    objExplorer.Quit
End Sub
'**************************************************************************
Function AppPrevInstance()   
    With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")   
        With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
            " AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")   
            AppPrevInstance = (.Count > 1)   
        End With   
    End With   
End Function    
'**************************************************************************
Function CommandLineLike(ProcessPath)   
    ProcessPath = Replace(ProcessPath, "\", "\\")   
    CommandLineLike = "'%" & ProcessPath & "%'"   
End Function
'**************************************************************************
Function CheckConnectionInternet()
    Dim strComputer,objPing,objStatus
        strComputer = "smtp.gmail.com"
        Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
        ("select * from Win32_PingStatus where address = '" & strComputer & "'")
        For Each objStatus in objPing
            If objStatus.Statuscode = 0 Then
                CheckConnectionInternet = True
            Else
                CheckConnectionInternet = False
            End If
        Next
End Function
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub
'**************************************************************************************