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")
Related
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.
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
Something which we encounter on a daily basis at work is when a member of the team opens Excel Workbook from a network share to update the workbook and forget to save and close the file after he is finished.
The issue arise when the user locks his workstation and walks away from his desk leaving his co-workers unable to modify the shared excel workbook (read only).
P.S Locking your workstation before each time you leave your desk is something crucial for security reasons and I encourage the reader to adopt this good cyber hygiene habit.
How can I solve this issue once and for all?
One might argue that opening such documents in the cloud might solve the problem but this depends on the nature of the contents being stored in the document.
I had some initial parameters defined wrong and it's always better to do stuff like this at the Modules level.
For your ThisWorkbook section, only have this code:
Private Sub Workbook_Open()
Call TheTimerMac
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call RestApplicationTimer
End Sub
Then in a standard Module insert the below code. The settings can be adjusted with the constants, which it looks like you understand (btw thanks for CDATE function -- shorter than TimeValeu)
I also inserted a couple audio warnings, partially just for my own entertainment. You look sharp enough that you can just nuke them if you don't like them.
'STANDARD MODULE CODE
'Constants
'Time settings
Const idleTimeLIMIT As String = "00:35:00" '<---- Edit this to whatever timer you want (hour:min:sec)
Const checkIntervalTime As String = "00:01:00" '<---- this can be executed frequently as it has low overhead
'Set this variable TRUE to confirm the macro is working with popup messages
Const conFirmRunning As Boolean = False
Dim LastCalculate As Date 'Make sure this is outside and above the other macros
Option Private Module
Public Sub TheTimerMac()
'message you can have displayed to make sure it's running
If conFirmRunning Then MsgBox "TheTimerMac is running."
'Schedules application to execute below macro at set time.
Application.OnTime Now + CDate(checkIntervalTime), "AnyBodyWorking"
End Sub
Private Sub AnyBodyWorking()
'OPTIONAL Warning messages to be spoken
Const TenMinuteWarning As String = "Your file will save and close in approximately 10 minutes"
Const FiveMinuteWarning As String = "Your file will save and close in approximately 5 minutes"
Const OneMinuteWarning As String = "This is the last warning. Your file will save and close in a little over a minute."
'message you can have displayed to make sure it's running
If conFirmRunning Then MsgBox "AnyBodyWorking Macro is running."
If LastCalculate = 0 Then
'Won't close application if lastCalc hasn't been set
Call RestApplicationTimer
ElseIf Now > LastCalculate Then
'if nothing has happened in the last idleTime interval... then it closes.
'close and lock it up!!
ThisWorkbook.Save
ThisWorkbook.Close
Exit Sub 'not even sure if this is needed, but probably good to be sure
''Optional spoken warnings
ElseIf DateDiff("S", Now, LastCalculate) < 60 Then
Application.Speech.Speak OneMinuteWarning
ElseIf DateDiff("S", Now, LastCalculate) < 300 Then
Application.Speech.Speak FiveMinuteWarning
ElseIf DateDiff("S", Now, LastCalculate) < 600 Then
Application.Speech.Speak TenMinuteWarnin
End If
Call TheTimerMac
End Sub
Sub RestApplicationTimer()
LastCalculate = Now + CDate(idleTimeLIMIT)
End Sub
Lastly, I think you could slightly improve the the locked function to be as follows and you could inculde it in your if statements.
Function IsLocked() As Boolean
IsLocked = _
GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
Environ$("computername") & "\root\cimv2"). _
ExecQuery("select * from Win32_Process where Name='logonui.exe'").Count > 0
End Function
Save the excel file as .xlsm to enable the storing of macros in the workbook itself.
Go to: Developer Tab -> Visual Basic
Double click: 'This Workbook', on the left hand pane
Paste the following VBA code:
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:01:00"), "Save1"
End Sub
Right Click VBAProject -> Insert -> Module
Paste the following VBA Code:
Sub Save1()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
If IsLocked(Environ$("computername")) > 0 Then
Workbooks("book1test.xlsm").Close SaveChanges:=True
End If
Application.OnTime Now + TimeValue("00:01:00"), "Save1"
End Sub
Function IsLocked(strComputer)
With GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
IsLocked = .ExecQuery("select * from Win32_Process where Name='logonui.exe'").Count '
End With
End Function
Save the Macro: Ctrl+s
This macro will be triggered every time you open the workbook, save your work every minute and only close the workbook if your screen/workstation is logged. You can remove the auto-save feature if you want.
Credits:
Check if computer is locked using VBscript
How to save Excel file every say minute?
#PGSystemTester this was the only way I could get it to work:
In ThisWorkbook:
Public idleTIME As Date '<---- Edit this to whatever timer you want (hour:min:sec)
Private Sub Workbook_Open()
idleTIME = CDate("00:10:00")
LastCalculate = Now + idleTIME
Check
End Sub
Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
LastCalculate = Now + idleTIME
End Sub
In module Option 1:
Public LastCalculate As Date
Const checkIntervalTime As String = "00:01:00"
Sub Check()
Call TheTimerMac
End Sub
Private Sub TheTimerMac()
Dim nextRunTime As Date
nextRunTime = Now + CDate(checkIntervalTime)
'Schedules application to execute below macro at set time.
Application.OnTime nextRunTime, "AnyBodyWorking"
End Sub
Private Sub AnyBodyWorking()
If Now > LastCalculate Then
'if nothing has happened in the last idleTime interval... then it closes.
'close and lock it up!!
ThisWorkbook.Save
ThisWorkbook.Close
Else
'executes the timerMacagain
Call TheTimerMac
End If
End Sub
module Option 2 (for locked screen):
Public LastCalculate As Date 'Make sure this is outside and above the other macros
Const checkIntervalTime As String = "00:00:30" '<---- this can be frequent as it has low overhead
Sub Check()
Call TheTimerMac
End Sub
Private Sub TheTimerMac()
Dim nextRunTime As Date
nextRunTime = Now + CDate(checkIntervalTime)
'Schedules application to execute below macro at set time.
Application.OnTime nextRunTime, "AnyBodyWorking"
End Sub
Private Sub AnyBodyWorking()
If Now > LastCalculate Or (IsLocked("FIBRE-X") > 0) Then
'if nothing has happened in the last interval idleTime OR Screen is Locked... then it closes.
'close and lock it up!!
ThisWorkbook.Save
ThisWorkbook.Close
Else
'executes the timerMacagain
Call TheTimerMac
End If
End Sub
Function IsLocked(strComputer)
With GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
IsLocked = .ExecQuery("select * from Win32_Process where Name='logonui.exe'").Count '
End With
End Function
Anything I can improve on this please?
I was trying to make digital watch in excel. So, when I will open a workbook then in a cell, lets say in E3 cell will show time and it will continue in every second so that it looks like a digital watch. I can do it in Access as access Form has On Timer event where I can write code to show time in a Textbox. Is there any alternative way in excel. I have tried below codes. But the codes need to click manually on Button1. Can I make it automatic to run the Button1_Click() sub in every second?
Sub Button1_Click()
Application.OnTime Now(), "RunningTime"
End Sub
Sub RunningTime()
Range("E3") = Format(Now(), "hh:mm:ss")
End Sub
I have also tried Workbook_Open() method but it runs once when I open the file.
Private Sub Workbook_Open()
Application.OnTime Now(), "RunningTime"
End Sub
There is no direct way to achieve it but you can apply some tricks to do that. First put below codes to a Module.
Public Times As Boolean
Sub TimerRun()
If Not Times Then Exit Sub
Application.OnTime Now() + TimeValue("00:00:01"), "TimerRun"
Range("E3").Value = Range("E3").Value + TimeValue("00:00:01")
End Sub
Sub TimerStop()
Times = False
End Sub
Then copy below codes and paste in Workbook_Open() event.
Private Sub Workbook_Open()
Range("E3").Value = Format(Now(), "HH:MM:SS")
Times = True
TimerRun
End Sub
If you want to make start or stop button so that you can start/stop timer manually by clicking on a button then put a form control command button and then assign TimerRun sub to start and assign TimerStop to stop timer.