Due to the instability of 2007, and a habit some people have of leaving complex files open for days on end without saving, I had decided on automatically shutting them if workbook not used for 30 minutes, leaving them back at the main menu used to open the workbooks. This works well and requires no interaction from the user even though a warning pop up is given. How can I get the macro to restart after it has run because when the menu is used to re-open files after the event has occurred the macro does not restart.
In workbook
Private Sub Workbook_Open()
If MsgBox("OPEN WORKBOOK WILL AUTOMATICALY SAVE AND CLOSE IF NOT USED FOR 30 MINUTES - THIS IS TO PROTECT INFORMATION AND WILL ONLY REQUIRE YOU TO RE-OPEN FILES FROM MAIN MENU IF YOU NEED IT AGAIN - CLICK YES TO PROCEED - CLICK NO TO NOT USE THIS SERVICE", vbYesNo) = vbYes Then
Call SetTime
Else
Exit Sub
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Disable
End Sub
Private Sub Workbook_SheetCalculate(ByVal SH As Object)
Call Disable
Call SetTime
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal SH As Object, ByVal Target _
As Excel.Range)
Call Disable
Call SetTime
End Sub
In module
Dim DownTime As Date
Sub SetTime()
DownTime = Now + TimeValue("00:30:00")
Application.OnTime DownTime, "ShutDown"
End Sub
Sub ShutDown()
Dim SH As IWshRuntimeLibrary.WshShell
Dim Res As Long
Set SH = New IWshRuntimeLibrary.WshShell
Res = SH.Popup(Text:="THE OPEN WORKBOOKS HAVE NOT BEEN USED FOR 30 MINS AND WILL NOW SAVE & CLOSE AUTOMATICALLY IN 10 SECONDS - SCREEN WILL RETURN TO MAIN MENU", secondstowait:=10, _
Title:="CONTENT SECURITY PROTECTION", Type:=vbOKOnly)
Dim WB As Workbook
For Each WB In Workbooks
If Not WB.Name = ThisWorkbook.Name Then
WB.Close SaveChanges:=True
End If
Next WB
End Sub
Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, Procedure:="ShutDown", _
Schedule:=False
End Sub
any pointers appreciated
requires widows script host object model to be run in "tools" - "references" of vba in menu workbook
Bookmarks