0

Does anyone know any VBA code that will close and save an excel file after a delay? I tried some kutools code that was supposed to close only after some idle time but it closes without checking for inactivity.

F_SO_K
  • 13,640
  • 5
  • 54
  • 83
Pedro Gaspar
  • 9
  • 1
  • 8
  • 3
    Using `Application.OnTime` you can schedule a Macro to close the Workbook, See [Chip Pearson's - OnTime](http://www.cpearson.com/excel/ontime.aspx) –  May 21 '18 at 06:55
  • In addition to using `OnTime`, You should be clearing the previous `OnTime` events to get only the last event to be active. You may want to check this link for some useful ideas: [link](https://stackoverflow.com/questions/4599796/how-can-i-check-for-or-cancel-multiple-pending-application-ontime-events-in-exce) – Hakan ERDOGAN May 21 '18 at 09:52

2 Answers2

0

Paste in Routine Module:

Option Explicit

Const idleTime = 30 'seconds
Dim Start
Sub StartTimer()
Start = Timer
Do While Timer < Start + idleTime
    DoEvents
Loop
'///////////////////////////////////////////////////////
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Step 1: Declare your variables
Dim ws As Worksheet
'Step 2: Unhide the Starting Sheet
Sheets("Sheet1").Visible = xlSheetVisible
'Step 3: Start looping through all worksheets
For Each ws In ThisWorkbook.Worksheets
'Step 4: Check each worksheet name
If ws.Name <> "Sheet1" Then
'Step 5: Hide the sheet
ws.Visible = xlVeryHidden
End If
'Step 6: Loop to next worksheet
Next ws
'Application.ScreenUpdating = True

Range("A1").Select

ThisWorkbook.Save

'Application.DisplayAlerts = True
'//////////////////////////////////////////////////////////
'Application.DisplayAlerts = False
Application.Quit
ActiveWorkbook.Close SaveChanges:=True

Application.DisplayAlerts = True
End Sub

Paste in ThisWorkbook :

Option Explicit

Private Sub Workbook_Open()
    StartTimer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    StartTimer
End Sub
Jerry
  • 100
  • 2
  • 9
0

Paste in Routine Module:

    Sub Reset()
Static SchedSave
    If SchedSave <> 0 Then
    Application.OnTime SchedSave, "SaveWork", , False
    End If
    SchedSave = Now + TimeValue("00:10:00")     '<--- Ten minutes
    Application.OnTime SchedSave, "SaveWork", , True
End Sub

Sub SaveWork()
MsgBox "Run the close workbook macro here."
'ThisWorkbook.Save
'Application.Quit
'ThisWorkbook.Close
End Sub

Paste in ThisWorkbook:

Private Sub Workbook_Open()
Reset
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Reset
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Reset
End Sub

Timer will start automatically when workbook is opened. Presently set for 10 minutes (can be adjusted). Closing macro code has been disabled and presently replaced with a MsgBox notice.

Jerry
  • 100
  • 2
  • 9