How to add a msgbox with start and end button to start and exit the loop in Vbscript

Question

I have written a VB Script code to simulate key press using do loop. This program simulate keystroke event from the keyboard after designated time interval. I need to add a message box to the script so that I can turn it off whenever my work is over. Currently it runs for infinite time in the background until you logoff your system.

This loop should be running in the background until someone manually end it by using the Yes/NO button from the MsgBox or Please suggest any other way to close this script.

Here is the code, I have written:

Set Wshell=CreateObject("Wscript.shell")
Do
Wshell.SendKeys "{SCROLLLOCK}"

WScript.sleep 10000
Loop

I also tried using select statement but it doesn't seem to work.

Answer 1

You can try something like that to ask a question for stopping the script :

Option Explicit
Dim Title,Ws
Title = "Ask a question to stop the script !"
Set Ws=CreateObject("Wscript.shell")
Do
    Ws.SendKeys "{SCROLLLOCK}"
    WScript.sleep 10000
    Call Ask_Question()
Loop

Sub Ask_Question()
    Dim Answer
    Answer=MsgBox("Did you want to stop this script ?"_
    & vbcr & "( Yes / No ) ?",vbQuestion+vbYesNo,Title)
        If Answer=vbYes Then
            Wscript.Quit(0)
        Else 
            Exit Sub    
        End If      
End Sub

Edit on 19/08/2016 @ 12:53

Just a general example :

Since, i don't know what program did you monitor, so i have plan with Notepad.exe as example This script can check if the program Notepad.exe is running or not If not so,it, ask you to stop the script or not !

Option Explicit
Dim ProcessPath,WshShell
ProcessPath = "%Windir%\System32\Notepad.exe"
Set WshShell = CreateObject("WScript.Shell")
If AppPrevInstance() Then 
    MsgBox "There is an existing proceeding !" & VbCrLF &_
    CommandLineLike(WScript.ScriptName),VbExclamation,"There is an existing proceeding !"    
    WScript.Quit   
Else 
    Do  
        Call Main()
        Pause(10) ' Pause 10 seconds 
        If CheckProcess(DblQuote(ProcessPath)) = False Then
            Call Ask_Question()
        End If  
    Loop
End If
'**************************************************************************
Function CheckProcess(ProcessPath)
    Dim strComputer,objWMIService,colProcesses,Tab,ProcessName
    strComputer = "."
    Tab = Split(ProcessPath,"\")
    ProcessName = Tab(UBound(Tab))
    ProcessName = Replace(ProcessName,Chr(34),"")
    Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colProcesses = objWMIService.ExecQuery _
    ("Select * from Win32_Process Where Name = '"& ProcessName & "'")
    If colProcesses.Count = 0 Then
        CheckProcess = False
    Else
        CheckProcess = True
    End if
End Function
'**************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**************************************************************************
Sub Pause(Secs)    
    Wscript.Sleep(Secs * 1000)    
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
'****************************************************************************
Sub Main()
   WshShell.SendKeys "{SCROLLLOCK}"
End Sub
'****************************************************************************
Sub Ask_Question()
    Dim Answer,Title
    Title = "Ask a question to stop the script !"
    Answer=MsgBox("Did you want to stop this script ?"_
    & vbcr & "( Yes / No ) ?",vbQuestion+vbYesNo,Title)
        If Answer=vbYes Then
            Wscript.Quit(0)
        Else 
            Exit Sub    
        End If      
End Sub
'****************************************************************************

Answer 2

It enables you to exit before the next button press is issued. To End the Script on Demand and let the other script run in background you need another solution, at most a different program which gives you a little interface where you can stop it. Or a second script which specifically ends your first one.

Set Wshell=CreateObject("Wscript.shell")
Do
  Wshell.SendKeys "{SCROLLLOCK}"
  continue = MsgBox ("Do you want to press the ScrollLock again?", vbYesNo, "Question")
  Select Case continue
  Case vbNo
    Exit Do
  End Select
  WScript.sleep 10000
Loop

Taken from this post: How to stop a vb script running in windows

Option Explicit
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "taskkill /f /im Cscript.exe", , True 
WshShell.Run "taskkill /f /im wscript.exe", , True  

There's a second script to kill of your script the hard way. I don't know how would you imagine to stop the script? If there is no GUI you can't do it on the time you wish. To combine the solutions you could do something like this:

continue = MsgBox ("Do you want to press the ScrollLock again?", vbYesNo, "Question")
Select Case continue
Case vbNo
Dim WshShell
   Set WshShell = WScript.CreateObject("WScript.Shell")
   WshShell.Run "taskkill /f /im Cscript.exe", , True 
   WshShell.Run "taskkill /f /im wscript.exe", , True  
End Select

And pull this popping up MsgBox in the corner of the screen, so If you dont want it anymore just press No and you're good. ^^