Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function GetLastInputInfo Lib "user32" (plii As Any) As Long
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Dim lngTimerID As Long
Dim strWorkbookName As String
Dim dblIdleTimeOut As Double
Dim blnSave As Boolean
Dim dblTimer As Double
Sub Workbook_AutoClose(Workbook_Name As String, idle_TimeOut As Double, Save_Wkb As Boolean)
Dim OneMinute_Interval As Long
strWorkbookName = Workbook_Name
dblIdleTimeOut = idle_TimeOut
blnSave = Save_Wkb
OneMinute_Interval = 60000
dblTimer = 1
lngTimerID = SetTimer(0, 0, OneMinute_Interval, AddressOf TimerProc)
End Sub
'********* CallBack and supporting procedures **********
Sub TimerProc()
' Static dblTimer As Double
Dim lii As LASTINPUTINFO
If GetForegroundWindow <> FindWindow("XLMAIN", Application.Caption) Then
dblTimer = dblTimer + 1
If dblTimer >= dblIdleTimeOut Then
GoTo Close_Workbook
Else: dblTimer = 0: Exit Sub
End If
End If
lii.cbSize = Len(lii)
Call GetLastInputInfo(lii)
If ((GetTickCount() - lii.dwTime) / 1000) >= ((dblIdleTimeOut) * 55) Then
GoTo Close_Workbook
Else: Exit Sub
End If
Close_Workbook:
KillTimer 0, lngTimerID
Application.OnTime Now + TimeSerial(0, 0, 1), "CloseWBK"
End Sub
Sub CloseWBK()
If blnSave Then
Workbooks(strWorkbookName).Close True
Else
Workbooks(strWorkbookName).Close False
End If
End Sub