WScript Popup not closing when user does not respond

[Steve_R]

The following is not closing after five seconds of no action by the user. Can anyone suggest a reason.

Sub inactivityShellPopUp()    
    Const ShowDurationSecs As Integer = 5
    response = 7


    response = CreateObject("WScript.Shell").PopUp( _
               "This program will close in " & _
               ShowDurationSecs & " seconds." & vbCrLf & _
               "Do you want it to close now?", ShowDurationSecs, _
               "Message Title", 4 + 32)




    Select Case response


    Case -1, 6
        'MsgBox "do the close here..."
        For Each w In Application.Workbooks
            w.Save
            'w.Close
        Next w
        Application.Quit
    Case Else


    End Select
    
End Sub

Code was tested in another WB and the same symptoms (or lack of) occurred.

It used to work but progressively deteriorated. How do I rule in/out WScript?

Other suggestions?

 

[Steve_R]

Narrowing this down:
- Modified code tests OK as vbs.
- The same code fails in Word.

It seems an issue exists between Office VBA and WScript. VBA is generating the Popup, it is just failing to close it after the allocated time.
The code used to work. I tried reversing this years Office updates to no avail. I tried a repair of Office (via add and remove programs). Apart from formatting the hard drive and starting over, can anyone suggest further options?

 

[Jaafar Tribak]

The Shell script popup is buggy and sometimes it doesn't work.

Have you considered using a userform with a count down instead ?

 

[Jaafar Tribak]

If you don't want to add a timer userform to your project, you can use the MessageBoxTimeout API which always work as follows :

Option Explicit

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" (ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageID As Long, ByVal lngMilliseconds As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Declare Function MessageBoxTimeout Lib "user32.dll" Alias "MessageBoxTimeoutA" ( ByVal hwnd As Long, ByVal lpText As String,ByVal lpCaption As String,ByVal uType As Long,ByVal wLanguageID As Long,ByVal lngMilliseconds As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If


Sub MsgBoxDelay()
    Const ShowDurationSecs As Integer = 5
    Dim lRet As Long
    
    lRet = MessageBoxTimeout(Application.hwnd, "This program will close in " & _
    ShowDurationSecs & " seconds." & vbCrLf & _
    "Do you want it to close now?", "Message Title", vbQuestion + vbYesNo, 0, ShowDurationSecs * 1000)
    
    MsgBox Switch(vbYes = lRet, "You clicked Yes", vbNo = lRet, "You clicked No", True, "TimeOut!")
End Sub