How to stop timeout?

[alee001]

I want to add a option for stop timeout by click on OK button but I don't know how to insert as following code, anyone have idea?

Private Declare PtrSafe Function MsgBoxTimeout _
    Lib "user32" _
    Alias "MessageBoxTimeoutA" ( _
        ByVal hwnd As LongPtr, _
        ByVal lpText As String, _
        ByVal lpCaption As String, _
        ByVal wType As VbMsgBoxStyle, _
        ByVal wlange As Long, _
        ByVal dwTimeout As Long) _
As Long

Sub btnMsgbox()
Dim q As Byte
    Call MsgBoxTimeout(0, "This message box will be closed after 4 seconds ", "Auto Close MsgBox", vbOKOnly + vbInformation, 0, 4000)
    If q = vbOK Then 'how to stop timeout?
        End
    Else
        Application.Quit
        ThisWorkbook.Close SaveChanges = False
    End If
End Sub

 

[John_w]

Try this:

Sub btnMsgbox()
    Dim retVal As Long
    Dim timeout As Single
    timeout = Timer + 4
    retVal = MsgBoxTimeout(0, "This message box will be closed after 4 seconds ", "Auto Close MsgBox", vbOKOnly + vbInformation, 0, 4000)
    If Timer < timeout Then
        MsgBox "OK clicked - timeout stopped"
    Else
        MsgBox "Timeout occurred"
        Application.Quit
        ThisWorkbook.Close SaveChanges:=False
    End If
End Sub

Changes are needed if the timeout crosses midnight.

 

[alee001]

It turned out to be as simple as adding a timer, thank you very much for your suggestion.