CODEWITHSUNDEEP
vbscripthta
theAdhocracy
theAdhocracy

Reputation: 146

AppActivate to Close Window not Looping

I have an application that often needs to be run without actively being monitored but, if it encounters an error, it will pop-up a message window and pause until a user has pressed close. It's causing a lot of problems at the moment as we're stress testing and cannot disable these messages, so someone has to constantly keep on eye on the process. I've been trying to come up with some VBScript that will keep checking for the pop-up message and automatically close it, using the AppActivate and SendKeys functions.

The problem is I need this to work within a GUI so the user can easily start/stop the code from running at the click of a button. I currently therefore have my VBScript wrapped in an HTA application with a single button, but for some reason it will only ever close the first instance of the message (multiple can be loaded simultaneously) and then stops.

Sub Testing
    Set objShell = CreateObject("WScript.Shell")
    counter = 1
    Do While counter < 50
        ret = objShell.AppActivate("Test Failure")
        counter = counter + 1
        If ret = True Then
            objShell.SendKeys "~"
        End If
    Loop
End Sub

With a button as follows:

<input type="button" value="Run Script" name="run_button" onClick="Testing"><p>

I need it to just constantly run in the background, only executing the SendKeys if the "Test Failure" window is selected/present and be able to stop the loop when a second button is pressed.

I'm clearly getting something wrong (VBScript does execute top to bottom, does it not?) and I've never really played around with these functions before, but it all seems to be setup correctly.

I've marked @Ansgar Wiechers answer as correct as it solved the root cause of my issue. The final code I ended up with was in two parts. The application:

<!doctype html>
<head>
<hta:application
    id="AutoCloseFailures"
    applicationname="AutoCloseFailures"
    icon=""
    singleinstance="yes"
    border="thick"
    borderstyle="complex"
    scroll="no"
    maximizebutton="no"
    version="0.1" />
<title>Auto-Close Failure Messages</title>
<meta http-equiv="x-ua-compatible" content="ie=8">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<script language="VBScript">

    ' Set Global Variables for Subroutines
    script = "#FOLDERPATH#\AutoCloseDEFXErrorsTimer.vbs"
    Set sh  = CreateObject("WScript.Shell")
    Set cmdTest = Nothing
    strVar = "testing2"

    Sub StartLoop
    ' Initiate VB Loop to Target Failure Windows & Close Them
        If cmdTest Is Nothing Then
            Set cmdTest = sh.Exec("wscript.exe """ & script & """")
            strVar = "testing"
        End If
        document.all.start.style.background="#777d84"
        document.all.start.style.color="#bfc4c9"
    End Sub

    Sub StopLoop
    ' Terminate VB Loop Process & Reset Application
        strScriptToKill = "AutoCloseDEFXErrorsTimer.vbs"
        Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
        Set colProcess = objWMIService.ExecQuery ( _
            "Select * from Win32_Process " & _
            "WHERE (Name = 'cscript.exe' OR Name = 'wscript.exe') " & _
            "AND Commandline LIKE '%"& strScriptToKill &"%'" _
        )
        For Each objProcess in colProcess
            objProcess.Terminate()
        Next
        Set cmdTest = Nothing
        document.all.start.style.background="#587286"
        document.all.start.style.color="#ffffff"
    End Sub

    Sub Window_onLoad
    ' Force Window Size
        window.resizeTo 400,190
        window.moveTo 1530, 0
    End Sub
</script>
<style>
    body {
        margin: 0;
        padding: 0;
        font-family: "Segoe UI", Geneva, sans-serif;
        background: #dae3f2;
    }
    h1 {
        font-size: 15pt;
        text-align: center;
        margin-bottom: 0;
        color: #273754;
    }
    button {
        padding:16px 32px;
        font-family:helvetica;
        font-size:16px;
        font-weight:100;
        color:#fff;
        background: #587286;
        border:0;
    }
    button:hover {
        background: #3B5C76;
    }
    .container {
        width: 100%;
        text-align: center;
    }
</style>
<BODY>
    <h1>Auto-Close Failure Messages</h1>
    <br>
        <div class="container">
            <button id="start" onclick="StartLoop">Start</button>
            <span>&nbsp;&nbsp;&nbsp;</span>
            <button id="stop" onclick="StopLoop">Stop</button>
        </div>
    <br>
</BODY>
</HTML>

And the supporting vbScript file:

Set sh = CreateObject("WScript.Shell")
While True
    active = sh.AppActivate("#WINDOW TITLE#")
    If active Then
        sh.SendKeys "~"
    End If
    WScript.Sleep 100
Wend

Upvotes: 0

Views: 1702

Answers (1)

Ansgar Wiechers
Ansgar Wiechers

Reputation: 200373

Your procedure is doing 50 iterations without delay, so it's probably already finished before it could even get to a second instance. What you'd normally do is run AppActivate and SendKeys in an infinite loop with a small delay:

Set sh = CreateObject("WScript.Shell")
While True
    active = sh.AppActivate("Test Failure")
    If active Then
        sh.SendKeys "~"
    End If
    WScript.Sleep 100
Wend

Put that in a script that you run asynchronously from your HTA:

<html>
<head>
<title>sample</title>
<HTA:APPLICATION
    ID="sample"
    APPLICATIONNAME="oHTA"
    SINGLEINSTANCE="yes">

<script language="VBScript">
script = "C:\path\to\script.vbs"
Set sh  = CreateObject("WScript.Shell")
Set cmd = Nothing

Sub StartLoop
    If cmd Is Nothing Then
        Set cmd = sh.Exec("wscript.exe """ & script & """")
    End If
End Sub

Sub StopLoop
    If Not cmd Is Nothing Then
        cmd.Terminate
        Set cmd = Nothing
    End If
End Sub
</script>
</head>

<body>
<p>
<button id="start" onclick="StartLoop">Start</button>
<button id="stop" onclick="StopLoop">Stop</button>
</p>
</body>
</html>

If required you can create the external script from the HTA on the fly:

Set fso = CreateObject("Scripting.FileSystemObject")
...
Set f = fso.OpenTextFile(script, 2, True)
f.WriteLine "Set sh = CreateObject(""WScript.Shell"")"
f.WriteLine "While True"
f.WriteLine "active = sh.AppActivate(""Test Failure"")"
...
f.Close

and delete it after after termination:

If Not cmd Is Nothing Then
    cmd.Terminate
    Set cmd = Nothing
    fso.DeleteFile script, True
End If

Upvotes: 1

Related Questions