VBA code to close an inputBox when system is inactive for some time.

[kelly mort]

In a post solved for me here by @Jaafar Tribak I used the computer’s system inactivity to display an inputBox where a user must enter certain credentials to get access to the userform again.

It’s working very great. But there has been new developments and I need help to take care of that.

As pointed out by @Jaafar Tribak the code works for modeless forms - which I have no problem with.

But I do have problems with inputBoxes. That is when an inputBox is active, that prevents @Jaafar Tribak code from running no matter how long the waiting period is.

Then it occurred to me that if I could find a way to close objects or processes such as those for message boxes, inputBoxes and the others, then I would be able to get the Sub running smoothly for me.

And the tricky part is that even if I find an easy way to close message boxes and inputBoxes, that would still present a bigger problem because I would also end up closing the input box I am using to restrict access to the userform.

So I am thinking of a way to id that inputBox so that when it comes to closing them, I will exclude that one.

But I have not been able to come up with anything yet.

For the message boxes, I have scripts from multiple sources that do that.

Could someone please help me out here?

Thanks in advance.

 

[Micron]

Answering because I'd sure like to know it if someone posts how to run any code at all when a modal dialog is open I'd like to read about it.
AFAIK, what you're asking is not possible if the dialog (message box or input box) is modal. I didn't read the linked code so hope you don't mind the suggestion, but why not hide the form before raising the dialog? Then when the dialog is dealt with you can unhide (or not) the form based on user response.

 

[Jaafar Tribak]

As Micron pointed out, you can't run code asynchronously when a modal dialog is on display. Actually, to be more precise, you can but, you will need a callback procdure like using a windows timer.

What do you want to happen when the InputBox becomes active ?

 

[Jaafar Tribak]

See if this works for you:

This should display the *main* inputbox ie: The one that you want to keep when the idle-time is reached. This Inputbox will stay on display until the user enters in it the required input or dismiss it.

If there happens to be some other inputbox (or any other dialog modal or non-modal) on display when the idle time is up, it will be automatically closed and the *main* InputBox will be displayed.

Distinguishing between the *main* Inputbox and the other Inputboxes is achieved by tagging the title of the *main* Inputbox with a non-breaking space character at the end... Note that you will need to tag the InputBox title with the EndCharacter argument in the UForm_OnIdleTimeReached Pseudo-Event as follows:

InputBox sPrompt, "Test" & EndCharacter

I hope I understood you correctly.

Here is a workbook demo:
IdleTimeout.xlsm



1- In a Standard Module:

Option Explicit

Public Enum TIME_UNIT
    °Seconds = 1&
    °Minutes = 60&
End Enum

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

Private Type LASTINPUTINFO
    cbSize As Long
    dwTime As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUf As LongPtr) As Long
    Private Declare PtrSafe Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function SetThreadExecutionState Lib "Kernel32.dll" (ByVal esFlags As Long) As Long
    Private Declare PtrSafe Function GetLastInputInfo Lib "user32" (plii As Any) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hUf As LongPtr) As Long
    Private Declare Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As LongPtr) As LongPtr
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare Function SetThreadExecutionState Lib "Kernel32.dll" (ByVal esFlags As Long) As Long
    Private Declare Function GetLastInputInfo Lib "user32" (plii As Any) As Long
#End If
   
Private oForm As Object
Private hForm As LongPtr
Private dMaxIdleTime As Double
Private lUnit As TIME_UNIT



Public Sub InitTimer( _
    ByVal Form As Object, _
    ByVal MaxIdleTime As Double, _
    Optional ByVal Unit As TIME_UNIT = °Seconds _
)

    Set oForm = Form
    If MaxIdleTime <= 0& Then MaxIdleTime = 1&
    dMaxIdleTime = MaxIdleTime * Unit
    lUnit = Unit
    Call IUnknown_GetWindow(Form, VarPtr(hForm))
    If hForm Then
        Call SetTimer(hForm, NULL_PTR, 1000&, AddressOf TimerProc)
    End If
   
End Sub


Public Sub EndTimer(Optional ByVal Dummy As Boolean)
 Call KillTimer(hForm, NULL_PTR)
 PreventSleepMode = False
End Sub



Private Sub TimerProc( _
    ByVal hwnd As LongPtr, _
    ByVal Msg As Long, _
    ByVal idEvent As LongPtr, _
    ByVal dwTime As Long _
)

    Const SC_CLOSE = &HF060&, WM_SYSCOMMAND = &H112
   
    Dim tLInfo As LASTINPUTINFO
    Dim dInterval As Double
    Dim sBuffer As String * 256&, lRet As Long
   
    tLInfo.cbSize = LenB(tLInfo)
    Call GetLastInputInfo(tLInfo)
    dInterval = Int(((dwTime - tLInfo.dwTime) / 1000&))

    If lUnit = °Seconds Then
        dInterval = IIf(dInterval = 1, dInterval + 1&, dInterval - 1&)
    End If

    If (dInterval Mod dMaxIdleTime + 1&) = Int(dMaxIdleTime) Then
       'Idle-Time out reached."
        If GetLastActivePopup(Application.hwnd) <> hwnd Then
            lRet = GetWindowText(GetLastActivePopup(Application.hwnd), sBuffer, 256&)
            If Right(Left(sBuffer, lRet), 1&) <> ChrW(160&) Then
                Call SendMessage(GetLastActivePopup(Application.hwnd), WM_SYSCOMMAND, SC_CLOSE, ByVal 0&)
                Call oForm.UForm_OnIdleTimeReached(dMaxIdleTime / lUnit, lUnit, ChrW(160&))
            End If
        Else
            Call oForm.UForm_OnIdleTimeReached(dMaxIdleTime / lUnit, lUnit, ChrW(160&))
        End If
    End If
   
    PreventSleepMode = True

End Sub


Private Property Let PreventSleepMode(ByVal bPrevent As Boolean)
    Const ES_SYSTEM_REQUIRED = &H1
    Const ES_DISPLAY_REQUIRED = &H2
    Const ES_AWAYMODE_REQUIRED = &H40
    Const ES_CONTINUOUS = &H80000000
 
    If bPrevent Then
        Call SetThreadExecutionState(ES_CONTINUOUS Or ES_DISPLAY_REQUIRED Or ES_SYSTEM_REQUIRED Or ES_AWAYMODE_REQUIRED)
    Else
        Call SetThreadExecutionState(ES_CONTINUOUS)
    End If
End Property

2- Code Usage in the UserForm Module:

Option Explicit

Private Sub UserForm_Initialize()
    'Time-out 1 Minute.
    Call InitTimer(Me, 1, °Minutes)
End Sub

Private Sub UserForm_Terminate()
    Call EndTimer
End Sub

Private Sub CommandButton1_Click()
    InputBox "This InputBox will automatically close when the Idle-timeout is reached !!!", "Test"
End Sub


' _________________________________________ PUBLIC PSEUDO-EVENT _____________________________________________


Public Sub UForm_OnIdleTimeReached( _
    Optional ByVal IdleTimeElapsed As Double, _
    Optional ByVal Unit As TIME_UNIT = °Seconds, _
    Optional ByVal EndCharacter As String _
)

    Dim sPrompt As String, sTimeUnit As String
    
    sTimeUnit = IIf(Unit = °Seconds, "Secs", "Mins")
    
    sPrompt = "The [" & IdleTimeElapsed & "] " & sTimeUnit & " Idle-Timeout was reached." & vbNewLine & vbNewLine & _
    "This InputBox will NOT automatically close because its title string was marqued with a non-breaking space character at the end."
    
    InputBox sPrompt, "Test" & EndCharacter

End Sub

 

[kelly mort]

@Jaafar Tribak
I use the InputBox to make decisions. Say how to generate a report and so on.

My concern is that when InputBox is active, your code as mentioned before cannot run since the InputBox is a modal one.

So when the input box is active and there is no system activity for some time, say one minute, then I want to close or quit the InputBox.

By so doing, I will have the opportunity to run the code from the link above.

This is part of the code you provided in the above link:

Private Sub Wb_OnIdleTimeReached(ByVal IdleMinutesElapsed As Long)
    MsgBox IdleMinutesElapsed & " Minute(s) have elapsed w/o user activity.", vbSystemModal, "Idle Time reached !!"
    'Do some other thing(s) here.
End Sub

But instead of the message box in the code sample above, I have replaced that with an InputBox. So I was thinking, if there is a way to close or cancel the other InputBoxes, then that particular InputBox I replaced with the Message box should be exempted from being closed.

 

[Jaafar Tribak]

if there is a way to close or cancel the other InputBoxes, then that particular InputBox I replaced with the Message box should be exempted from being closed

This is not very clear.

You say you have other inputboxes. What are they for ?

Also, why are you replacing the MsgBox with another InputBox ?

 

[Jaafar Tribak]

In order to differenciate between the inputboxes that you want to be closed and the inputbox that you want to keep active , you will need to somehow flag it.

One idea is perhaps to marque the inputbox you want to keep active with some unusual character in its caption. That way, the code would read each Inputbox title and exclude the one whose title contains the unusual character.

EDIT:
Something such as :
InputBox Prompt:="Hello", Title:="Active InputBox *"

Notice the star * character at the end of the titlebar.

 

[kelly mort]

Yes
I am replacing the msgBox with an InputBox.

I am using it to restrict access to the form.
So until the user enters the right input, access to the form is not allowed.

And it shows up anytime the system stays inactive for a given period of time - say 1 minute.

So this inputbox is not to be closed with code because it must and can stay active as long as possible until the user correctly enters the required input.

Private Sub Wb_OnIdleTimeReached(ByVal IdleMinutesElapsed As Long)
    MsgBox IdleMinutesElapsed & " Minute(s) have elapsed w/o user activity.", vbSystemModal, "Idle Time reached !!"
    'Do some other thing(s) here.
End Sub

When I say other inpuboxes, I mean any other inputbox that is not called within this code:

Private Sub Wb_OnIdleTimeReached(ByVal IdleMinutesElapsed As Long)
    MsgBox IdleMinutesElapsed & " Minute(s) have elapsed w/o user activity.", vbSystemModal, "Idle Time reached !!"
    'Do some other thing(s) here.
End Sub

If any other inputbox is active for the given time period, then I want to close it then bring up the one I replaced with the msgbox.

I hope this helps

 

[Micron]

Again, I doubt you can. Not even with sendkeys. Modal boxes are waiting for user clicks. Now if you used a userform instead and made it modal - maybe.

 

[Micron]

Now if you used a userform instead and made it modal - maybe.

I forgot that I tried that yesterday. I could not interact with the immediate window to close it, nor any code window to try to run any code to close it. I'm fairly certain that I've seen timer events not run on time when a modal object was open. Why can't you just hide the form instead of raising an input box? Or is the user opening input box and leaving it open?