VBscript to close any popup message box
A strange thing happened when i was trying to run QTP tests from Quality Center , there was this error message popped up after every test run.
Until the message box was not closed manually QC would wait indefinitely, defeating the whole purpose of automation.
So here is the vbcript that would run indefinitely waiting for the popup; and close it for tests to continue:
Set wshShell = CreateObject("WScript.Shell")
Do
ret = wshShell.AppActivate("System Settings Change")
If ret = True Then
wshShell.SendKeys "%N"
Exit Do
End If
WScript.Sleep 500
Loop
Until the message box was not closed manually QC would wait indefinitely, defeating the whole purpose of automation.
Set wshShell = CreateObject("WScript.Shell")
Do
ret = wshShell.AppActivate("System Settings Change")
If ret = True Then
wshShell.SendKeys "%N"
Exit Do
End If
WScript.Sleep 500
Loop
To: ADITYA LALRA,
ReplyDeleteFrom: Steve@crowncert.com
Because [nSecondsToWait] argument of VBscript popup message box does not work, I am pleased to suggest the following 3 solutions:
'The following is a HTA File
'To run this file, you should
'replace ◁ into <
'replace ▷ into >
◁!-- ------------------------------------------- --▷
◁!doctype html▷
◁html▷
◁head▷
◁title▷My HTA◁/title▷
◁meta http-equiv="X-UA-Compatible" content="IE=9"▷
◁style▷
body { font-family: 'Segoe UI'; font-size: 10pt; }
◁/style▷
◁HTA:APPLICATION
ID="MyHTA"
INNERBORDER="no"
CONTEXTMENU="no"
/▷
◁script language="VBScript"▷
Dim strMsg
Dim Seconds
Dim strWindowTitle
Dim Opt
Sub window_onLoad()
◁!-- ---------- Typical PopUp() ---------- --▷
Dim WshShell, BtnCode
Set WshShell = CreateObject("WScript.Shell")
BtnCode = WshShell.Popup("Comment allez-vous?", 10, "Typical PopUp()", 4 + 32)
Select Case BtnCode
Case 6 MsgBox "Popup(vbYes) Je suis ravie d'apprendre que vous allez bien."
Case 7 MsgBox "Popup(vbNo) J'espere que vous irez mieux."
Case -1 MsgBox "Popup(Timeout) Y-a-t-il quelqu'un ?"
Case Else MsgBox "Popup() Unexpected Selection"
End Select
'Issue: [nSecondsToWait] Not Functioned
◁!-- ------------------------------------------- --▷
MsgBox "Popup() Method in HTA", vbYesNo, "HTA-Popup"
'3 Solutions:
'Solution #1
strMsg = qq("Comment allez-vous ?")
Seconds = 10
Opt = 4 + 32 'vbYesNo + vbQuestion + vbDefaultButton3
strWindowTitle = "Popup1()"
Popup_1 strMsg, Seconds, strWindowTitle, Opt
'Issue: Not Resolved in This Procedure
◁!-- ------------------------------------------- --▷
MsgBox "The End of Solution #1", vbYesNo, "Popup1()"
'Solution #2
strMsg = qq("Comment allez-vous ?")
Seconds = 10
Opt = 4 + 32 'vbYesNo + vbQuestion
strWindowTitle = "Popup2()+Include"
Dim timerID
Dim mSec
mSec = (Seconds * 1000)
'Call MsgClose() after 10 seconds
timerID = setTimeout("MsgClose()", mSec, "VBScript")
Popup_2 strMsg, Seconds, strWindowTitle, Opt
◁!-- ----------------------------------- --▷
' Call Include and then call Doit
tempFolder = CreateObject("WScript.Shell").ExpandEnvironmentStrings( "%TEMP%" )
tempFile = "Popup2.vbs"
tempPath = tempFolder & "\" & tempFile 'Control File for reboot
Include tempPath
◁!-- ------- --▷
'BtnCode = WshShell.Popup("Comment allez-vous?",10,"Popup2()",36)
Select Case BtnCode
Case 6 MsgBox "Popup2(vbYes) Je suis ravie d'apprendre que vous allez bien !" ,64,"Je suis ravie d'apprendre que vous allez bien !"
case 7 MsgBox "Popup2(vbNo) J'espere que vous irez mieux !",64,"J'espere que vous irez mieux !"
case -1 MsgBox "Popup2(Timeout!) Y-a-t-il quelqu'un ?",vbQuestion,"Y-a-t-il quelqu'un ?"
Case Else
MsgBox "Popup2() Unexpected Selection???"
End Select
'Issue: Resolved by the predetermined selection
◁!-- ------------------------------------------- --▷
MsgBox "The End of Solution #2", vbYesNo, "Popup2()"
---- Page 1 of 2 Pages
Sub Popup_1(Msg,Wait,Title,Options)
ReplyDeleteSet objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Dim tempFolder : Set tempFolder = objFSO.GetSpecialFolder(2)
Dim tempName : tempName = "Popup2.vbs"
Set objOutputFile = objFSO.CreateTextFile(tempFolder&"\"&tempName, True)
objOutputFile.Writeline "Set WshShell = CreateObject(""WScript.Shell"")"
objOutputFile.WriteLine "BtnCode = WshShell.Popup("&Msg&","&Wait&","&qq(Title)&","&Options&")"
objOutputFile.WriteLine "Select Case BtnCode"
objOutputFile.WriteLine "case 6 MsgBox ""Popup1(vbYes) Je suis ravie d'apprendre que vous allez bien !"" ,64,""Je suis ravie d'apprendre que vous allez bien !"""
objOutputFile.WriteLine "case 7 MsgBox ""Popup1(vbNo) J'espere que vous irez mieux !"",64,""J'espere que vous irez mieux !"" "
objOutputFile.WriteLine "case -1 MsgBox ""Popup1() Timeout! Y-a-t-il quelqu'un ?"",vbQuestion,""Y-a-t-il quelqu'un ?"" "
objOutputFile.WriteLine "case else MsgBox ""Popup1() Unexpected Selection???"",vbQuestion,""Y-a-t-il quelqu'un ?"" "
objOutputFile.WriteLine "End Select"
objOutputFile.Close
WshShell.Run tempFolder&"\"&tempName
End Sub
Sub Popup_2(Msg,Wait,Title,Options)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Dim tempFolder : Set tempFolder = objFSO.GetSpecialFolder(2)
Dim tempName : tempName = "Popup2.vbs"
Set objOutputFile = objFSO.CreateTextFile(tempFolder&"\"&tempName, True)
objOutputFile.Writeline "Set WshShell = CreateObject(""WScript.Shell"")"
objOutputFile.WriteLine "BtnCode = WshShell.Popup("&Msg&","&Wait&","&qq(Title)&","&Options&")"
objOutputFile.Close
End Sub
Sub Include(sInstFile)
On Error Resume Next
Dim fso, f, s
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(sInstFile) Then
Set f = fso.OpenTextFile(sInstFile)
s = f.ReadAll
f.Close
ExecuteGlobal s
End If
Set fso = Nothing
Set f = Nothing
End Sub
Function qq(strIn)
qq = Chr(34) & strIn & Chr(34)
End Function
Sub Sleep(MSecs)' Fonction pour faire une pause car wscript.sleep ne marche pas dans un HTA
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim tempFolder : Set tempFolder = objFSO.GetSpecialFolder(2)
Dim tempName : tempName = "Sleeper.vbs"
If Not objFSO.FileExists(tempFolder&"\"&tempName) Then
Set objOutputFile = objFSO.CreateTextFile(tempFolder&"\"&tempName, True)
objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
objOutputFile.Close
End If
CreateObject("WScript.Shell").Run tempFolder&"\"&tempName &" "& MSecs,1,True
End Sub
Sub MsgClose()
'close all Popup Windows
Do
return = CreateObject("WScript.Shell").AppActivate(strWindowTitle)
If return = True Then
'Send the key combination to Popup Dialog
'Alt + Y - This is the equivelant of clicking Yes.
'Alt + N - This is the equivelant of clicking No.
CreateObject("WScript.Shell").SendKeys "%Y"
WScript.Sleep 1000
window.clearTimeout timerID
End If
Loop Until return = False
End Sub
' - Page 2 of 3 Pages
'Solution #3
ReplyDeletestrMsg = qq("Comment allez-vous ?")
Seconds = 10
Opt = 4 + 32 'vbYesNo + vbQuestion
Dim strFile : strFile = "Popup3.vbs"
Set WshShell = CreateObject("WScript.Shell")
Dim tempFolder : Set tempFolder = objFSO.GetSpecialFolder(2)
Dim tempName : tempName = "Popup3.vbs"
Dim tempPath : tempPath = tempFolder&"\"&tempName
'Create the designated file, True=overwrite if exists
Set objOutputFile = objFSO.CreateTextFile(tempPath, True)
◁!-- --------------------------------------------------------------------------------------------------- --▷
'Syntax: ExitCode = object.Run([ProgramPath & Space (1) & ArgList], [intWindowStyle], [bWaitOnReturn:=True])
'ProgramPath =
strScriptPath = MyHTA.commandLine
strScriptPath = replace(strScriptPath,Chr(34),"")
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
strSourceDir = objFSO.GetParentFolderName(strScriptPath)
Dim strFile
strFile = "Popup.vbs" 'File PreCoded and File Name PreDesignated
ProgramPath = strSourceDir & "\" & strFile
◁!-- --------------------------------- --▷
If Not objFSO.FileExists(ProgramPath) Then
strMsg = ProgramPath & " doesn't exist."
strTitle = "Nothing@ProgramPath"
Opt = 0+0+16 'vbOKOnly+ vbDefaultButton1+vbCritical
MsgBox strMsg, Opt, strTitle
◁!-- ------------------- --▷
Set tempFolder = Nothing
Set objOutputFile = Nothing
Set objFSO = Nothing
Set WshShell = Nothing
'WScript.Quit Not Applicable in HTA
QuitHTA
ExitHTA
End If
strWindowTitle = "Popup3()"
Arglist = qq(strMsg) & " " & Seconds & " " & qq(qq(strWindowTitle)) & " " & Opt
'ProgramPath = strSourceDir & "\" & strFile
◁!-- ---------------------------------- --▷
objOutputFile.writeline "' NAME: " & strFile
objOutputFile.writeline "' You may delete this temp file"
objOutputFile.writeline "Dim WshShell"
objOutputFile.writeline "Dim return"
objOutputFile.writeline "Set WshShell = CreateObject(""WScript.Shell"")"
objOutputFile.writeline "return = WshShell.Run(" & Chr(34) & "wscript " & qq(qq(ProgramPath)) & Space (1) & Trim(Arglist) & ", 1, True"")"
objOutputFile.Close
WshShell.Run tempPath, 1, True
Set tempFolder = Nothing
Set objOutputFile = Nothing
Set objFSO = Nothing
Set WshShell = Nothing
'No More Issue
◁!-- ------------------------------------------------------------------ --▷
MsgBox "The End of Solution #3", vbYesNo, "Popup3()"
'Sub window_onLoad()
End Sub
Sub QuitHTA()
◁!-- -------------------------------------------------------- --▷
'SOFT EXIT CODE
window.close()
End Sub
Sub ExitHTA()
◁!-- -------------------------------------------------------- --▷
'HARD EXIT
'mshta.exe stays resident in memory after the HTA closes
'If your HTA is set only to allow one instance to run at a time, you cannot run your HTA again until you kill the mshta.exe process.
Dim strComputer
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'mshta.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Set objWMIService = Nothing
Set objProcess = Nothing
Set colProcessList = Nothing
End Sub
◁/script▷
◁/head▷
◁body bgcolor="white"▷
◁!--{{InsertControlsHere}} - Do not remove this line--▷
◁/body▷
◁/html▷
'- Page 3 of 3 Pages
Note: Source code could be sent via e-mail.
This comment has been removed by the author.
ReplyDeletePopup.vbs
ReplyDeletestrMsg = WScript.Arguments.Item(0)
Seconds = WScript.Arguments.Item(1)
strWindowTitle = WScript.Arguments.Item(2)
Opt = WScript.Arguments.Item(3)
strWindowTitle = strWindowTitle & " (Typical Procedure)"
Dim WshShell, BtnCode
Set WshShell = WScript.CreateObject("WScript.Shell")
'BtnCode = WshShell.Popup("Comment allez-vous ?", 7, "Use Typical Procedure As It Is", 4 + 32)
BtnCode = WshShell.Popup(strMsg, Seconds, strWindowTitle, Opt)
Select Case BtnCode
case 6 WScript.Echo "Popup.vbs(vbYes) Je suis ravie d'apprendre que vous allez bien."
case 7 WScript.Echo "Popup.vbs(vbNo) J'espere que vous irez mieux."
case -1 WScript.Echo "Popup.vbs(Timeout) Y-a-t-il quelqu'un ?"
Case Else MsgBox "(Popup.vbs) Unexpected Result???"
End Select
MsgBox "The End of Pop.vbs"
Set WshShell = Nothing