Just want to ask if why do I keep receiving this error?
Run-time error '1004': Method 'OnTime' of object'_Application' failed
So, I'm trying to close my workbook but whenever I'm doing it, the error shows. The highlighted line after clicking the Debug button is Application.OnTime timeCheck, "SaveThis", , False in the Workbook_BeforeClose sub. What seems to be the problem here?
Private Sub Workbook_Open() 'place in ThisWorkbook
timeCheck = Now + TimeValue("00:15:00")
Application.OnTime timeCheck, "SaveThis"
End Sub
Sub SaveThis() 'place in Module
timeCheck = Now + TimeValue("00:15:00")
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.OnTime timeCheck, "SaveThis"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean) 'place in ThisWorkbook
Application.OnTime timeCheck, "SaveThis", , False
End Sub
It seems to me that you are trying to schedule a call to SaveThis() in the future, right when the application is about to close. Why would you want to do that?, if the error never happened, then how will you guarantee that the call happens when the workbook is already closed?
If what you meant to do is save the workbook before closing the workbook, then you will need to change your code as follows:
Private Sub Workbook_Open() 'place in ThisWorkbook
timeCheck = Now + TimeValue("00:15:00")
Application.OnTime timeCheck, "SaveThis"
End Sub
Sub SaveThis()
timeCheck = Now + TimeValue("00:15:00")
SaveRightNow ' This is a new sub that you will need to add
Application.OnTime timeCheck, "SaveThis"
End Sub
Sub SaveRightNow()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean) 'place in ThisWorkbook
SaveRightNow ' Saves the workbook without having to schedule a call in the future
End Sub
Related
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If wrkBkClose = False Then
MsgBox ("Please Use The Save & Close Button"), vbInformation
Cancel = Not wrkBkClose
End If
End Sub
Workbook BeforeClose Event
Sub CloseSave()
Application.EnableEvents = False
Application.DisplayAlerts = False
If Application.Workbooks.Count = 1 Then
wrkBkClose = True
ActiveWorkbook.Close SaveChanges:=True
Application.Quit
Else
With ActiveWorkbook
.Close SaveChanges:=True
End With
End If
End Sub
Module under a button
The above code works as expected, except the Excel application does not close completely. The following is still left open:
Could someone please help me understand why the application will not completely close? Or is there another way I should be going about performing this procedure. Thanks in advance for the help.
Close Workbook Only via Button
If it is the only open workbook, it will also quit Excel.
ThisWorkbook
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If wrkBkClose = False Then
MsgBox ("Please Use The Save & Close Button"), vbExclamation
Cancel = True
End If
End Sub
Module1
Option Explicit
Public wrkBkClose As Boolean
Sub CloseSave()
wrkBkClose = True
If Application.Workbooks.Count = 1 Then
ThisWorkbook.Save
Application.Quit
Else
ThisWorkbook.Close SaveChanges:=True
End If
End Sub
VBA code for autosaving and for closing the workbook if idle is working. The problem is, Excel continues to run the code if another instance of the program was open when the code closed the workbook. I think what I need to do is to unload the workbook, but I can't figure out how. I've tried "Unload Workbook," "Unload ThisWorkbook," and "Unload ResetTimer" [the module which detects activity and starts the 35 minute timer over]. I'm getting an error that Workbook/ThisWorkbook/ResetTimer are not object that can be unloaded. I can't find a list of what objects can be unloaded.
Here is the code under ThisWorkbook
Option Explicit
Private Sub ThisWorkbook_Open()
If ThisWorkbook.ReadOnly = False Then
Application.OnTime Now + TimeValue("00:30:00"), "SaveThis"
End If
If ThisWorkbook.ReadOnly = False Then
Application.OnTime Now + TimeValue("00:35:00"), "CloseDownFile"
End If
End Sub
Private Sub ThisWorkbook_Close()
Unload ThisWorkbook
' Unload ResetTimer
End Sub
Private Sub ThisWorkbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub
Private Sub ThisWorkbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub
Private Sub ThisWorkbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub
Here is the Module:
Public CloseDownTime As Variant
Public Sub ResetTimer()
On Error Resume Next
If Not IsEmpty(CloseDownTime) Then Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
CloseDownTime = Now + TimeValue("00:35:00") ' change as needed
Application.OnTime CloseDownTime, "CloseDownFile"
End Sub
Public Sub CloseDownFile()
On Error Resume Next
ThisWorkbook.Close SaveChanges:=True
Unload ThisWorkbook
End Sub
Sub SaveThis()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.OnTime Now + TimeValue("00:30:00"), "SaveThis"
End Sub
Your regular module should look more like this (see below). This removes the logic from your ThisWorkbook module.
Option Explicit
Public CloseTime As Variant
Public SaveTime As Variant
Public Sub StartTimers()
StartSaveTimer
StartCloseTimer
End Sub
Public Sub CancelTimers()
CancelSaveTimer
CancelCloseTimer
End Sub
Sub StartSaveTimer()
If ThisWorkbook.ReadOnly Then Exit Sub
CancelSaveTimer 'remove any existing timer
SaveTime = Now + TimeValue("00:30:00")
Application.OnTime SaveTime, "SaveThis"
End Sub
Sub CancelSaveTimer()
On Error Resume Next
Application.OnTime EarliestTime:=SaveTime, Procedure:="SaveThis", Schedule:=False
On Error GoTo 0
End Sub
Sub StartCloseTimer()
If ThisWorkbook.ReadOnly Then Exit Sub
CancelCloseTimer 'remove any existing timer
CloseTime = Now + TimeValue("00:35:00")
Application.OnTime CloseTime, "CloseThis"
End Sub
Sub CancelCloseTimer()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, Procedure:="CloseThis", Schedule:=False
On Error GoTo 0
End Sub
Public Sub CloseThis()
On Error Resume Next
CancelTimers
ThisWorkbook.Close SaveChanges:=True
End Sub
Sub SaveThis()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
StartSaveTimer
End Sub
Here is the corrected code to save every 30 minutes and to close after 35 minutes of no use. Thank you to #TimWilliams for all of the help!
Code under ThisWorkbook:
Option Explicit
Private Sub Workbook_Open()
Call StartTimers
End Sub
Private Sub Workbook_Close()
CancelTimers
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
CancelCloseTimer
StartCloseTimer
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
CancelCloseTimer
StartCloseTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
CancelCloseTimer
StartCloseTimer
End Sub
Code for Module:
Option Explicit
Public CloseTime As Variant
Public SaveTime As Variant
Public Sub StartTimers()
StartSaveTimer
StartCloseTimer
End Sub
Public Sub CancelTimers()
CancelSaveTimer
CancelCloseTimer
End Sub
Sub StartSaveTimer()
If ThisWorkbook.ReadOnly Then Exit Sub
CancelSaveTimer 'remove any existing timer
SaveTime = Now + TimeValue("00:30:00") 'save frequency, change as needed
Application.OnTime SaveTime, "SaveThis"
End Sub
Sub CancelSaveTimer()
On Error Resume Next
Application.OnTime EarliestTime:=SaveTime, Procedure:="SaveThis", Schedule:=False
On Error GoTo 0
End Sub
Sub StartCloseTimer()
If ThisWorkbook.ReadOnly Then Exit Sub
CancelCloseTimer 'remove any existing timer
CloseTime = Now + TimeValue("00:35:00") 'idle time before closing, change as needed
Application.OnTime CloseTime, "CloseThis"
End Sub
Sub CancelCloseTimer()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, Procedure:="CloseThis", Schedule:=False
On Error GoTo 0
End Sub
Public Sub CloseThis()
On Error Resume Next
CancelTimers
ThisWorkbook.Close SaveChanges:=True
End Sub
Sub SaveThis()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
StartSaveTimer
End Sub
I'm building a form that can take the values from the clipboard and auto fill itself.
In order to get the values I use application.ontime to run a macro every two seconds and read the clipboard. The start is done in userform initialize.
That works fine.
Sub Userform_Initialize()
On Error Resume Next
fireTime = Now + TimeValue("00:00:02")
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=True
On Error GoTo 0
End Sub
If I close the userform I added a queryclose to make sure the copy macro stops:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=False
End Sub
Works fine also.
The actual macro is this:
Public fireTime As Date
Sub copy()
On Error GoTo ErrHandler
Dim oData As New DataObject
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
DataObj.GetFromClipboard
strPaste = DataObj.GetText(1)
Row1 = Split(strPaste, vbNewLine)(0)
col = Split(Row1, vbTab)
If UBound(Split(col(14), "-")) = 2 Then
If Len(col(0)) = 7 Then
If Left(col(3), 4) = "4600" Then
oData.SetText Text:=Empty 'Clear
oData.PutInClipboard 'take in the clipboard to empty it
UF_RegistreraVM.TB_LevNr.Text = col(0)
Levnr = col(0)
' ... and so on..
'Line below does not work
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=False
Exit Sub
End If
End If
End If
ErrHandler:
On Error Resume Next
fireTime = Now + TimeValue("00:00:02")
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=True
On Error GoTo 0
End Sub
And the only line that does not work is when I set application.ontime to false in the nested ifs.
That line is the same as the one in queryclose, but it doesn't work here.
When I debug the code errors on that line and due to On Error GoTo ErrHandler it jums down to ErrHandler and sets a new time to run the macro.
What is the issue that with the code, why can't I turn of the ontime inside the ifs?
I get the run time error when I open the workbook. The open function works great without the close function, but as soon as I add the close function I get the error. Any suggestions?
Private Sub Workbook_Open()
Application.ScreenUpdating = False
For Each cell In Range("A1:Z1")
If cell.Value = "X" Then
cell.EntireColumn.Hidden = True
Else
cell.EntireColumn.Hidden = False
End If
Next cell
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Protect "1962"
Next ws
ThisWorkbook.Protect "1962", True
ThisWorkbook.Save
End Sub
The error occurs because you protect the worksheet in the BeforeClose routine. Hence the Workbook_Open doesn't have access to update it the next time it is being opened. Try this:
Private Sub Workbook_Open()
Dim cell As Range
Application.ScreenUpdating = False
ActiveSheet.Unprotect "1962" '<<<<
For Each cell In Range("A1:Z1")
If cell.Value = "X" Then
cell.EntireColumn.Hidden = True
Else
cell.EntireColumn.Hidden = False
End If
Next cell
ActiveSheet.Protect "1962" '<<<<
End Sub
Couple of macros are used. In then "ThisWorkbook" module, paste:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Stop execution when workbook closes
On Error Resume Next
Application.OnTime Heure, "Calcul", , False
End Sub
Private Sub Workbook_Open()
'start execution when workbook opens
Application.OnTime Now + TimeValue("00:01:00"), "Calcul"
End Sub
In module :
VB:
Public Heure As Date
Sub Calcul()
Heure = Now + TimeValue("00:01:00")
Application.OnTime Heure, "Calcul"
Range("B65536").End(xlUp).Offset(1) = [A1]
End Sub
Cell A1 will be copied every minute in column B (starting B2). Now I want this function to start at 00:08:00 but wasn't able to achieve it.
As long as the workbook can remain open, the below code:
Private Sub Workbook_Open()
'start execution when workbook opens
Application.OnTime Now + TimeValue("00:01:00"), "Calcul"
End Sub
Can be replaced with the following:
Private Sub Workbook_Open()
'start execution at 8 AM when workbook opens
If Hour(Now()) < 8 Then
' If it is before 8 AM
Application.OnTime Int(Now()) + TimeSerial(8, 0, 0), "Calcul"
Else
' Otherwise begin 8 AM the next day
Application.OnTime Int(Now()) + 1 + TimeSerial(8, 0, 0), "Calcul"
End if
End Sub