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