Actions are not being triggered by idle timer

Question

The goal of the code is to see if the computer is idle. If enough time passes it then first gives a warning that the file is about to save and then if there is no response for another bit of time to auto-save the file. However, the idle timer is not working in triggering any of my subs. It was working before when I just had it autosaving.

This is my code in ThisWorkbook to automatically run my 3 subs.

Option Explicit

Sub Workbook_Open()
    IdleTime
    WarningMessage
    CloseDownFile
End Sub

The naming is a little off as CloseDownFile doesn't actually close down the file, but I just never changed the name.

This is the bit of code that was running fine:

Private Type LASTINPUTINFO
    cbSize As Long
    dwTime As Long
End Type

Private Declare Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)

Private Declare Function GetTickCount Lib "kernel32" () As Long

Function IdleTime() As Single
    Dim a As LASTINPUTINFO
    a.cbSize = LenB(a)
    GetLastInputInfo a
    IdleTime = (GetTickCount - a.dwTime) / 1000
End Function

Public Sub CloseDownFile()
    On Error Resume Next
    If IdleTime > 30 Then
        Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
        ThisWorkbook.Save
    Else
        CloseDownTime = Now + TimeValue("00:00:30") ' change as needed
        Application.OnTime CloseDownTime, "CloseDownFile"
    End If
End Sub

These are my 3 main subs in module 1 that stemmed from the piece of code that was running fine but now the timer is not working. Also, now that Option Explicit is on, it is saying that CloseDownTime is not defined:

Option Explicit

Private Type LASTINPUTINFO
    cbSize As Long
    dwTime As Long
End Type

Private Declare Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)

Private Declare Function GetTickCount Lib "kernel32" () As Long

Function IdleTime() As Single
    Dim a As LASTINPUTINFO
    a.cbSize = LenB(a)
    GetLastInputInfo a
    IdleTime = (GetTickCount - a.dwTime) / 1000
End Function

Public Sub CloseDownFile()
    On Error Resume Next

    If IdleTime > 30 Then
        Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
        ThisWorkbook.Save
    Else
        CloseDownTime = Now + TimeValue("00:00:30") ' change as needed
        Application.OnTime CloseDownTime, "CloseDownFile"
    End If
End Sub

Public Sub WarningMessage()
    On Error Resume Next

    If IdleTime > 20 Then
        Application.StatusBar = "Saving File" & ThisWorkbook.Name
        ShowForm     
    End If
End Sub

Here is the ShowForm sub called by WarningMessage:

Option Explicit

Public Sub ShowForm()
    Dim frm As New UserForm1
    frm.BackColor = rgbBlue

    frm.Show
End Sub

Here is the code ran in Userform1:

Private Sub CommandButton1_Click()
    Hide
    m_Cancelled = True
    MsgBox "Just Checking!"

    CloseDownTime = Now + TimeValue("00:00:30")
    Application.OnTime CloseDownTime, "WarningMessage"
End Sub

Private Sub Image1_Click()
End Sub

Private Sub CommandButton2_Click()
    Hide
    m_Cancelled = True
    MsgBox "Then how did you respond?"

    CloseDownTime = Now + TimeValue("00:00:30")
    Application.OnTime CloseDownTime, "WarningMessage"
End Sub

Private Sub TextBox1_Change()
End Sub

score 1 · Accepted Answer · answered Jan 04 '19 at 13:57

I think the issue relates to when in this Section If IdleTime > 30 Then you aren't starting the Application.OnTime again to keep checking the process. Also, because the timer is set at 30 seconds, it's always going to be greater than 30 seconds when getting to this sub. So it won't keep checking.

See if structuring the code like this helps.

Option Explicit

Private Type LASTINPUTINFO
  cbSize As Long
  dwTime As Long
End Type

Public Declare Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)
Public Declare Function GetTickCount Lib "kernel32" () As Long

Public Function IdleTime() As Long
    Dim LastInput As LASTINPUTINFO
    LastInput.cbSize = LenB(LastInput)
    GetLastInputInfo LastInput
    IdleTime = (GetTickCount - LastInput.dwTime) \ 1000
End Function

Public Sub CloseDownFile()
    Dim CloseDownTime As Date

    Debug.Print "Going here IdleTime is " & IdleTime

    If IdleTime > 30 Then
        Debug.Print "Saving"
        Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
        ThisWorkbook.Save
    End If

    'You always want to run this code to keep checking
    CloseDownTime = Now + TimeValue("00:00:15")
    Application.OnTime CloseDownTime, "CloseDownFile"
End Sub

Public Sub WarningMessage()
    If IdleTime > 20 Then
        Application.StatusBar = "Saving File" & ThisWorkbook.Name
        ShowForm
    End If
End Sub

Public Sub ShowForm()
    Dim frm As UserForm1: Set frm = New UserForm1
    frm.BackColor = rgbBlue
    frm.Show
 End Sub

Actions are not being triggered by idle timer

1 Answers1