VBA code to check inactivity on a sheet and display an alert

[kelly mort]

I have been doing some digging for a while now and I have come across cool stuffs concerning what I want to achieve.

The only setback is that they are scattered all over in bits.

So I came across this code from @Tom Urtis which tacks the movement of the mouse.

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
x As Long
y As Long
End Type
 
Sub PositionXY()
Dim lngCurPos As POINTAPI
Do
GetCursorPos lngCurPos
Range("A1").Value = "X: " & lngCurPos.x & " Y: " & lngCurPos.y
DoEvents
Loop
End Sub

I want to display an alert when there is inactivity in the system for a given duration.

**I will use this to prompt user to login.
**If the alert is on already, I don’t want to pop it again(as that might cause some form of conflict)

Each time there is mouse movement, I want to reset the timer.

When I leave the active workbook to any other window, I want to show the alert (in this case an input box to accept user password) immediately.

I have also come across amazing workarounds from @Jaafar Tribak and the likes:

But I am finding it tougher to rightfully connect the dots.

I will be more than happy if someone can help me out for it.

Thanks in advance
Kelly Mort

 

[Legacy 143009]

Please find the sample file below. Maybe it can be achieved with a less complex procedure but this is the best I can do. In this example, it checks for 10 sec. inactivity. I add a comment in Module1 where you should change the duration per your need. Have a good day!

Easyupload.io - Upload Files and Share Them Easily

Uplaod files easily and share them with your friends and colleagues. File upload solution for everyone. Upload big files and get a link to share effortlesly.

easyupload.io

 

[kelly mort]

Please find the sample file below. Maybe it can be achieved with a less complex procedure but this is the best I can do. In this example, it checks for 10 sec. inactivity. I add a comment in Module1 where you should change the duration per your need. Have a good day!

Easyupload.io - Upload Files and Share Them Easily

Uplaod files easily and share them with your friends and colleagues. File upload solution for everyone. Upload big files and get a link to share effortlesly.

easyupload.io

I have tested the code.
It keeps popping the message “move mouse” even when I am still interacting with the sheet or workbook.

And sometimes the message keeps popping continuously.

 

[Legacy 143009]

After thinking a bit, any effort will be useless.
When you click inside a cell to enter a value, any macro will be stopped. This is the nature of Excel. You can't change it.
Any user can enter into a cell and can wait for hours without doing nothing.

 

[kelly mort]

After thinking a bit, any effort will be useless.
When you click inside a cell to enter a value, any macro will be stopped. This is the nature of Excel. You can't change it.
Any user can enter into a cell and can wait for hours without doing nothing.

Okay

But in my case, user would be able to interact with cells directly.

All entries would be done with userforms

 

[Legacy 143009]

user would be

You mean won't be?

 

[kelly mort]

You mean won't be?

Yes

 

[Jaafar Tribak]

If you are using a modeless userform, you can try the following code.

If the userform is modal or if the workbook is in edit mode as pointed out by Flashbond then, you will need to use a windows timer. I don't have a code for that at hand but, in theory, it could be done.

IdleTime.xlsm

This is the code if you are using a modeless userform:

1- Add a new class Module to your vbaproject and give the newly created class the name of CIdleTimer
Place this code in the Class Module:

Option Explicit

Event OnIdleTimeReached(ByVal IdleMinutesElapsed As Long)
Private WithEvents MonitorUserInput As CommandBars

Private Type LASTINPUTINFO
    cbSize As Long
    dwTime As Long
End Type

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount64" () As LongLong
    #Else
        Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
    #End If
    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 Declare Function GetTickCount Lib "kernel32" () 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 lMaxIdleTime As Long


Public Property Let MaxIdleTimeInMinutes(ByVal vNewValue As Long)
    If vNewValue <= 0& Then
        Set MonitorUserInput = Nothing
        PreventSleepMode = False
        MsgBox "Error !!" & vbNewLine & "Idle time must be greater to 1 Minute.", vbCritical
        Exit Property
    End If
    lMaxIdleTime = vNewValue
End Property

Public Property Get MaxIdleTimeInMinutes() As Long
    MaxIdleTimeInMinutes = lMaxIdleTime
End Property


Private Sub Class_Initialize()
    Set MonitorUserInput = Application.CommandBars
    Call MonitorUserInput_OnUpdate
End Sub

Private Sub Class_Terminate()
    PreventSleepMode = False
End Sub

Private Sub MonitorUserInput_OnUpdate()

    Static bIdleTimeReached As Boolean
    Dim tLInfo As LASTINPUTINFO
    Dim lInterval As Double
    
    tLInfo.cbSize = LenB(tLInfo)
    Call GetLastInputInfo(tLInfo)    
   lInterval = Int(((GetTickCount() - tLInfo.dwTime) / 1000&))
    If lInterval = 0& Then
        bIdleTimeReached = False
    End If
    If (lInterval / 60& >= lMaxIdleTime) And lMaxIdleTime <> 0 Then
        If bIdleTimeReached = False Then
            bIdleTimeReached = True
            RaiseEvent OnIdleTimeReached(lMaxIdleTime)
        End If
    End If
    PreventSleepMode = True
    With Application.CommandBars.FindControl(ID:=2040&)
        .Enabled = Not .Enabled
    End With
    
End Sub

Private Property Let PreventSleepMode(ByVal bPrevent As Boolean)
    Const ES_SYSTEM_REQUIRED As Long = &H1
    Const ES_DISPLAY_REQUIRED As Long = &H2
    Const ES_AWAYMODE_REQUIRED = &H40
    Const ES_CONTINUOUS As Long = &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- UserForm Module:

Option Explicit

Private WithEvents Wb As CIdleTimer

Private Sub UserForm_Initialize()
    Set Wb = New CIdleTimer
    Wb.MaxIdleTimeInMinutes = 1  '<== 1 Minute test.
End Sub

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

 

[kelly mort]

Thanks @Jaafar Tribak
Your code is working great
I am very grateful

About this part:

When I leave the active workbook to any other window, I want to show the alert (in this case an input box to accept user password) immediately.

Is there an easy solution to it?

 

[Jaafar Tribak]

Password for what ?

And when you say "leave to any other window", does that include other excel workbooks ? Have you tried using the Window_Deactivate event ?