excelvbaundefinedidle-timer

Actions are not being triggered by idle timer


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

Solution

  • 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