Display MsgBox wait for 10 seconds then click on yes automatically

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi,

I have set of codes wherein msgbox prompts with vbYesNo buttons like:(MsgBox
"Would you like to Start Timer ?" vbYesNo + vbDefault,1)
The code doen't jump on next code line until the user press the Yes or No
button.
Here is the problem where i need help.

Is there any way if, the user does not respond for next 20 seconds or so,
the programme himselfs assumes that Yes button (true value) being pressed &
continue or jump on the next line of code.

Thanks in advance.
 
'----------------------------------------------------------------
Sub TimedMsgBox()
'----------------------------------------------------------------
Dim cTime As Long
Dim WSH As Object

Set WSH = CreateObject("WScript.Shell")
cTime = 20 ' 20 secs
Select Case WSH.Popup("Open an Excel file?!", cTime, "Question",
vbYesNo)
Case vbOK
MsgBox "You clicked OK"
Case vbCancel
MsgBox "You clicked Cancel"
Case -1
MsgBox "Timed out"
Case Else
End Select
End SUb


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
Hello Mr. Bob,

Thanks for your early response. My programming language is not good enough.
I have tried with the codes supplied by you but not getting the desired
answer.
The codes in my programming are given below. Could you help me to solve this.

'my codes
ws1.Range("A6").Value _
= "Last Run : " & Format(Now(), "ddd, dd/mm/yyyy hh:mm:ss AM/PM")

response = MsgBox("Do you want to Start Timer ?", vbYesNo + vbDefaultButton,
1)
'if here the user does not respond for 10 sec, then the programme sould
assume the response vbYes, & then start the next procedure. Is it possible?
If response = vbYes Then
StartTimer
End If
If response = vbNo Then
StopTimer
End If

-----------------------------------------------------------------------------------------------
Start Timer & Stop Timer is another procedures. like:
Sub StartTimer()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Summery")
'RunWhen = DateSerial(2006, 7, cRunIntervalDates)
'RunWhen = Now + TimeSerial(0, ws1.Range("E4"), 0)
RunWhen = Now + TimeSerial(0, 0, cRunIntervalTime * ws1.Range("E5"))
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, _
procedure:=cRunWhat, schedule:=False
End Sub
--
Thanks,
Vikram P. Dhemare


Bob Phillips said:
'----------------------------------------------------------------
Sub TimedMsgBox()
'----------------------------------------------------------------
Dim cTime As Long
Dim WSH As Object

Set WSH = CreateObject("WScript.Shell")
cTime = 20 ' 20 secs
Select Case WSH.Popup("Open an Excel file?!", cTime, "Question",
vbYesNo)
Case vbOK
MsgBox "You clicked OK"
Case vbCancel
MsgBox "You clicked Cancel"
Case -1
MsgBox "Timed out"
Case Else
End Select
End SUb


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
It won't work if you don't use the code supplied, normal MsgBox doesn't time
out.

Dim RunWhen As Double

Sub Vikram()
Const TIMED_OUT As Long = -1
'my codes
ws1.Range("A6").Value _
= "Last Run : " & Format(Now(), "ddd, dd/mm/yyyy hh:mm:ss
AM/PM")

response = TimedMsgBox("Do you want to Start Timer ?", "AppTitle", 20)
If response = vbYes Or response = TIMED_OUT Then
StartTimer
Else
StopTimer
End If

End Sub

Sub StartTimer()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Summery")
'RunWhen = DateSerial(2006, 7, cRunIntervalDates)
'RunWhen = Now + TimeSerial(0, ws1.Range("E4"), 0)
RunWhen = Now + TimeSerial(0, 0, cRunIntervalTime * ws1.Range("E5"))
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, _
procedure:=cRunWhat, schedule:=False
End Sub

'----------------------------------------------------------------
Function TimedMsgBox(Msg As String, _
Title As String, _
Duration As Long) As Long
'----------------------------------------------------------------
Dim cTime As Long
Dim WSH As Object

Set WSH = CreateObject("WScript.Shell")
TimedMsgBox = WSH.Popup("Open an Excel file?!", Duration, "Question",
vbYesNo)
End Function




--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

Vikram Dhemare said:
Hello Mr. Bob,

Thanks for your early response. My programming language is not good enough.
I have tried with the codes supplied by you but not getting the desired
answer.
The codes in my programming are given below. Could you help me to solve this.

'my codes
ws1.Range("A6").Value _
= "Last Run : " & Format(Now(), "ddd, dd/mm/yyyy hh:mm:ss AM/PM")

response = MsgBox("Do you want to Start Timer ?", vbYesNo + vbDefaultButton,
1)
'if here the user does not respond for 10 sec, then the programme sould
assume the response vbYes, & then start the next procedure. Is it possible?
If response = vbYes Then
StartTimer
End If
If response = vbNo Then
StopTimer
End If

-------------------------------------------------------------------------- ---------------------
Start Timer & Stop Timer is another procedures. like:
Sub StartTimer()
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Summery")
'RunWhen = DateSerial(2006, 7, cRunIntervalDates)
'RunWhen = Now + TimeSerial(0, ws1.Range("E4"), 0)
RunWhen = Now + TimeSerial(0, 0, cRunIntervalTime * ws1.Range("E5"))
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, _
procedure:=cRunWhat, schedule:=False
End Sub
 
Hello Mr. Bob,

Its not working. I think I am doing it wrongly.
The Programme doen't jump on next line unless & until the user press the Yes
or No Button.
What I want is, if the user does not respond within next 10 secs (after
displaying the TimedMsgBox) (as you said if response is TIMED_OUT) then the
programme should jump on next code line.
 
Works for me. Don't forget 20 secs is a long time to wait.

Try reducing it to 5 secs and see if it works, then gradually increase.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
Hi Mr. Bob

I have tried but still the msgbox doesn't disappear after certain time. I am
doing it wrong. Plz. help me out.
 
Sorry, no other ideas, it works fine for me.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top