Bdtjtk

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

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