I have a workbook that is using some macros to automatically close it after some idle time elapses.
There is 1 issue, if the user has other excel workbooks (regardless if its xlsx or xlsm) after the procedure for it to close the target file. it REOPENS the target file again and can continue in a loop like this until the user closes all of their open workbooks quitting the application.
any advice on how to tweak this code so that the Application.OnTime events will stop effectively when the target workbook has closed would be appreciated.
The goal was simple:
If a user leaves their desk, or they are working on another workbook and they forget to close the file it will save and close the workbook and only that workbook without disrupting any other function or workbook
this does work fine on its own only if and only if the workbook that has this code is the only book open in the application.
In "Thisworkbook" I have below
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopTimer
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call StopTimer
Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call StopTimer
Call SetTimer
End Sub
In a separate module I have below:
Dim DownTime As Date
Sub SetTimer()
DownTime = Now + TimeValue("00:15:00")
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDown", Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDown", Schedule:=False
End Sub
Sub ShutDown()
Application.DisplayAlerts = False
With Workbooks("Customer Complaint Tracker.xlsm")
.Saved = True
.Close
End With
End Sub
I have tried using a different method to run a timer which I think worked on windows timing instead of the application itself but I could not get it to function.
Related
Background infromation:
This workbook is on shared point and I'm trying to run a Marco in Desktop app.
The objective on the marco is to close the workbook automatically after 10 mins. I want to ensure that users do not keep the workbook open without using it.
However, when I run the below code, I get an error message
"Cannot run the marco "https://wfp-mysharepoint.com............" This Macro may not be available in this workbook or marcos maybe disabled.
The code is as follows:
Private Sub Workbook_Open()
Picktime
End Sub
Sub Picktime()
savetime = Hour(Now) & ":" & Minute(Now) + 1 & ":" & Second(Now)
Application.OnTime savetime, "Please_close"
End Sub
Sub Please_close()
ThisWorkbook.Close (True)
End Sub
The procedure Workbook_Open is an event (that runs automatically) on opening of the workbook and therefore has to be in the scope of the workbook ThisWorkbook. Other events that are worksheet related are located in the scope of their worksheet.
All other code should go into a normal module. Especially code that needs to be found by Application.OnTime can only be located in a normal module.
So in ThisWorkbook:
Private Sub Workbook_Open()
Picktime
End Sub
In a normal module:
Public Sub Picktime()
Dim SaveTime As Variant
SaveTime = Now() + TimeValue("00:01:00")
Application.OnTime EarliestTime:=SaveTime, Procedure:="Please_close"
End Sub
Public Sub Please_close()
ThisWorkbook.Close SaveChanges:=True
End Sub
Note that it is easer to add one minute to Now() by using Now() + TimeValue("00:01:00")
Hello One of the VP where I work made a workbook that has the below macro in it. For some reason after I open the file and close it on my own the file re-opens itself every so often. Is this because the timer in the workbook is set to reset its closing process? I am not very well versed in VBA yet so that may not be even close to what the Sub Reset is doing. Note this apparently only happens to me and not anyone else and we have no idea why. only VBA experience I have is like making workbooks that don't close as pranks or making time stamps or color counting formulas.
Dim xTime As String
Dim xWB As Workbook
Private Sub Workbook_Open()
'Updated by Extendoffice 2019/1/20
On Error Resume Next
xTime = "00:30:00"
Set xWB = ActiveWorkbook
If xTime = "" Then Exit Sub
Reset
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
On Error Resume Next
If xTime = "00:30:00" Then Exit Sub
Reset
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If xTime = "" Then Exit Sub
Reset
End Sub
Sub Reset()
Static xCloseTime
If xCloseTime <> 0 Then
ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , False
End If
xCloseTime = Now + TimeValue(xTime)
ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , True
End Sub
The timer is a async process so it will keep running in background
you can reset it on closing of the workbook.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Reset
End Sub
The workbook is being reopened when Application.OnTime calls the SaveWork1 that is attached to it. Static xCloseTime is storing the time that the SaveWork1 is scheduled to be ran. The time is being stored so that the Application.OnTime event can be cancelled.
I believe that you are the only one being affected because you are the only one that dabbles in VBA. VBA errors may cause Static variables to lose their values. When Static xCloseTime the SaveWork1 is rescheduled.
It appears that if the OnTime event is registered by a programmatic MyBook.Close statement, then OnTime never runs.
This code works fine:
Sub TestOnTime()
Application.OnTime Now + TimeValue("00:00:05"), "MySub"
End Sub
Sub MySub()
Debug.Print "hello"
End Sub
Run TestOnTime. MySub will execute, as expected.
And this code runs fine:
ThisWorkbook:
Dim WithEvents oApp As Application
Private Sub Workbook_Open()
Set oApp = Application
End Sub
Private Sub oApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Application.OnTime Now + TimeValue("00:00:05"), "MySub"
End Sub
Module 1:
Sub MySub()
Debug.Print "hello"
End Sub
Manually close another workbook to fire oApp_WorkbookBeforeClose.
MySub executes, as expected.
But this code fails. The OnTime event never runs.
Book 1
ThisWorkbook:
Dim WithEvents oApp As Application
Private Sub Workbook_Open()
Set oApp = Application
End Sub
Private Sub oApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Application.OnTime Now + TimeValue("00:00:05"), "MySub"
End Sub
Module 1:
Sub MySub()
Debug.Print "hello"
End Sub
Book 2
Module 1:
Sub Test()
ThisWorkbook.Close
End Sub
Run Test to close Book 2.
Book 1 oApp_WorkbookBeforeClose
executes, as expected.
But the Book 1 MySub event never runs.
Why?
Why doesn't OnTime execute if registered by a Workbook_BeforeClose event? No code is running in the book that's closing. OnTime works no problem with other events (eg programmatically opening a workbook). Somehow, closing a workbook programmatically breaks OnTime. Why?
As Book 2 is being closed, You should include the Application.OnTime procedure in Book 2 and not in Book 1
Also, I think those books should be saved once and not new books.
Sub test()
Application.OnTime Now + TimeValue("00:00:05"), "Book 1.xlsm!MySub"
ThisWorkbook.Close
End Sub
EDIT Jul 6 -
You are closing the workbook and then you are trying to run a macro MySub in the same workbook after 5 seconds. Macro in the same workbook will not run once the book is closed. Application will reopen the file to run the macro. If you want to close Book2 after 5 seconds of closing Thisworkbook then --
in Thisworkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnTime Now + TimeValue("00:00:05"), "Book2.xlsm!Test"
End Sub
So, after closing Thisworkbook, macro named "Test" in Book2 will run and will close that workbook.
I implemented some code into a few of my excel sheets that would cause the file to autosave periodically. The issue I am running into with the code, is that when it is executed, it reopens the files that have been closed that also contain the same code.
I am looking for a way to have VBA autosave documents every so often, but it would no longer run if the file isn't open.
This is the code I have implemented:
Contained in "ThisWorkbook":
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("03:00:00"), "Save1"
End Sub
Contained in "Module 3":
Sub Save1()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.OnTime Now + TimeValue("03:00:00"), "Save1"
End Sub
A note: The code between all of the documents is 100% identical (except the TimeValue, which varies by a few hours among some of them).
Try the next approach, please:
Adapt the OnTime call to a better qualified Sub:
Private Sub Workbook_Open()
scheduleTime = Now + TimeValue("03:00:00")
Application.OnTime scheduleTime, "Module3.Save1"
End Sub
Make the Sub in discussion Private, and create a new Public variable on top of the module:
Public scheduleTime As Date
Private Sub Save1()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
scheduleTime = Now + TimeValue("03:00:00")
Application.OnTime scheduleTime, "Module3.Save1"
End Sub
Clear the already set OnTime procedure:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnTime scheduleTime , "Module3.Save1", , False
End Sub
The first two items will solve the opening of other workbooks when the active workbook procedure is called. But, this should not happen and I am afraid that this is not the real opening mechanism, the workbooks are open by their own OnTime function call.
If my above supposition is True, the item 3 alone will solve the issue...
As you may notice, OnTime is an Application method, not a Workbook method.
This means that, even if you close the Workbook, so long as the Excel Application is still open that OnTime is still counting down. Once it hits zero, it will try to run the Subroutine - but the workbook is closed. Rather than throw an Error, Excel will reopen the Workbook, and then run the Subroutine.
In order to stop this, you will need to unscheduled the Subroutine before you close the Workbook, which will also mean Storing the time. So, you will need a Module that looks something like this:
Option Private Module
Option Explicit
Private AutoRunTime AS Date
Public Sub AutoSaveWorkbook()
ThisWorkbook.Save
AutoRunTime = Now()+TimeSerial(3,0,0) '3 hours
Application.OnTime AutoRunTime, "AutoSaveWorkbook", True
End Sub
Public Sub CancelAutoSave()
Application.OnTime AutoRunTime, "AutoSaveWorkbook", False
End Sub
Then, in the Workbook_Open even you call AutoSaveWorkbook to start things off, and in the Workbook_BeforeClose even you call CancelAutoSave to end them
VBA newbie here. I am looking for a way that will allow my excel file to automatically save after a delay of 1 min after data input.
For example:
User Inputs Data --> Timer Starts (1min)
5 seconds passes.
User inputs Data --> Timer Restarts (1min)
1 min passes.
Excel File Saves - until the user starts inputting data again
Any thoughts?
One possibility is to leverage the Workbook.SheetChange event and Application.OnTime. You'll also need a Public variable, ScheduledTime in the example below.
Every time any (non-chart) sheet is changed (e.g. via data entry):
Any previously scheduled save, as long as it's still within the one-minute window, is cancelled.
A new save is scheduled for one minute out.
So something like the following:
In the ThisWorkbook code module:
Option Explicit
Public ScheduledTime
Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
On Error Resume Next
Application.OnTime EarliestTime:=ScheduledTime, Procedure:="SaveTheFile", Schedule:=False
On Error GoTo 0
ScheduledTime = Now + TimeValue("00:01:00")
Application.OnTime EarliestTime:=ScheduledTime, Procedure:="SaveTheFile"
End Sub
In a regular code module:
Public Sub SaveTheFile()
ThisWorkbook.Save
End Sub
You could just as well use the Worksheet Change event if you want to restrict this to a particular sheet.
I have a similar take on this to BigBen.
In ThisWorkbook module:
Option Explicit
Public SnapShot As String
Private Sub Workbook_Open()
StartTimer
End Sub
Sub StartTimer()
If SnapShot = vbNullString Then SnapShot = Now
If DateDiff("s", SnapShot, VBA.CStr(Now)) >= 10 Then ThisWorkbook.Save
RestartTimer
End Sub
Sub RestartTimer()
Application.OnTime Now + TimeValue("00:00:10"), "ThisWorkbook.StartTimer"
End Sub
And then in the worksheet you are monitoring:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.SnapShot = Now
End Sub