Excel - timer to close workbook

Question

Quite a while ago I whipped up (or found) some code to automatically close a shared workbook after a period if the user had left it open (eg overnight or all day). The code works well, except for when it closes the workbook within it resides; it also closes all workbooks and excel as well (without an Application.Quit). The users are becoming anoyed at this, does anyone know how I can get it to only close (Thisworkbook), not all the others?

Thanks.

Code below:

Option Explicit

' Declarations
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 mlngTimerID As Long

' start the timer
Public Sub StartTimer(lngInterval As Long)
   mlngTimerID = SetTimer(0, 0, lngInterval, AddressOf TimerCallBack)
End Sub

' when the timer goes off
Public Sub TimerCallBack(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)

 ' stop the timer
 StopTimer

  ' don't save if read only
 If ThisWorkbook.ReadOnly = False Then

  ' save
  ThisWorkbook.Save

 End If

 ' exit without saving
 ThisWorkbook.Activate
 ThisWorkbook.Close False

End Sub

Public Sub StopTimer()
   KillTimer 0, mlngTimerID
End Sub

'To use timer:
'To start the timer
'Call startTimer(1000)'1000 = 1 Second
'To stop timer
'Call stopTimer

Answer 1

I know this is an older question but I thought I'd share a resolution that works for me. Upon opening, the workbook is stored as a Public variable so that it will be the only workbook closed when the timer expires. If the workbook is closed before time expires, then the timer is cancelled. If the timer expires and the workbook is still open, then it will be saved and closed automatically.

Insert code below into "ThisWorkbook"

'When the workbook is opened, call StartTimer()
Public Sub Workbook_Open()
    Run "StartTimer"
End Sub

'Detect if the workbook is closed
Public Sub Workbook_BeforeClose(Cancel As Boolean)
    'Cancel Saveclose
    Run "StopTimer"
End Sub

Insert code below into a Module

'Global variables
Public RunWhen As Double
Public Const cRunIntervalSeconds = 300 ' seconds (set to 5 minutes)
Public Const cRunWhat = "SaveClose"  ' the name of the procedure to run
Public GlobalBook As Workbook

'Start Timer using interval set in global variables
Sub StartTimer()
    Set GlobalBook = ActiveWorkbook
    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=True
End Sub

'Stop the Timer whenever the workbook is closed prematurely
Public Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=False
End Sub

'Close the workbook automatically once the Timer has expired
Public Sub SaveClose()
    'Time is up, workbook will save and close automatically
    Dim wb As Workbook
    For Each wb In Workbooks
        'Check to see if workbook is still open
        If wb.Name = GlobalBook.Name Then
            Set wb = Application.Workbooks(GlobalBook.Name)
            'Close workbook and Save Changes
            wb.Close SaveChanges:=True
        End If
        Next
End Sub

Answer 2

Have you tried using Excel's "OnTime" instead ?

http://msdn.microsoft.com/en-us/library/aa195809(v=office.11).aspx

Tim