I've a xl add-in (.xlam file) which uses one of it's sheets to store data gathered from a UserForm.
If Excel closes then I'd like this file to save itself in the add-ins directory.
Currently here:
C:\Users\myName\AppData\Roaming\Microsoft\AddIns\ExcelStartUp_ExcelVersion.xlam
In the addin's before close event I've the following:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Save
End Sub
Looks ok but it saves a copy of the xlam into whatever the CurDir is. So it is reproducing iself around our file system!
If I'm in one of the code windows of the xlam file and open the Immediate window then the following two lines are inconsistent!:
?ThisWorkbook.Path
?Thisworkbook.fullname
I have been encountering the same problem and found that it is caused by the addin changing its ReadOnly status to True under certain circumstances (cannot pinpoint exactly under which circumstances but seems to be linked to having multiple instances of Excel open).
Therefore, the solution is to add a check to your code as follows:
If ThisWorkbook.ReadOnly = False Then
ThisWorkbook.Save
End If
I've had this behavior - addins being saved here and there - when more than one instance of Excel is open. (I was actually just googling it last night, but couldn't find anything confirming it.) I've got a function called from the BeforeClose event that checks for more than one instance.
Private Sub App_WorkbookBeforeClose(Cancel As Boolean)
If Not ThisWorkbook.Saved Then
If MsgBox(ThisWorkbook.Name & " Addin" & vbCrLf & "is unsaved. Save?", _
vbExclamation + vbYesNo, "Unsaved Addin") = vbYes Then
If ExcelInstanceCount > 1 Then
MsgBox "More than one Excel instance running." & vbCrLf & _
"Save cancelled", _
vbInformation, "Sorry"
Exit Sub
Else
ThisWorkbook.Save
End If
End If
End If
End Sub
Function GetExcelInstanceCount() As Long
Dim hwnd As Long
Dim i As Long
Do
hwnd = FindWindowEx(0&, hwnd, "XLMAIN", vbNullString)
i = i + 1
Loop Until hwnd = 0
GetExcelInstanceCount = i - 1
End Function
use the Application object's ActiveWorkbook.Save method instead of its ThisWorkbook.Save method. See this link: http://www.techrepublic.com/blog/microsoft-office/avoid-this-potential-gotcha-when-using-add-ins-to-distribute-excel-macros/
Related
The Workbook.BeforeClose event triggers when the workbook is about to close but before the saving message prompt which allows cancelling it.
How can I detect when the workbook is already closing past the point where it can be cancelled without removing nor replacing the saving message with a custom one?
One workaround I have found online is to use the event together with the Workbook.Deactivate event which looks like this:
Code in the workbook:
Private Sub Workbook_BeforeClose(ByRef Cancel As Boolean)
closing_event = True
check_time = VBA.Now + VBA.TimeSerial(Hour:=0, Minute:=0, Second:=1)
Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event"
End Sub
Private Sub Workbook_Deactivate()
If closing_event Then
VBA.MsgBox Prompt:="Closing event."
Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event", Schedule:=False
End If
End Sub
Code in a module:
Public closing_event As Boolean
Public check_time As Date
Public Sub disable_closing_event()
closing_event = False
End Sub
One very specific edge case where it triggers incorrectly is if you click to close the workbook and in less than one second close the saving message (press Esc to do it fast enough) and change to another workbook (Alt + Tab) it triggers the Deactivate event with the closing_event condition variable still set to True because disable_closing_event has still not set it to False (scheduled by Application.OnTime for when one second goes by).
I would like to find a solution that isn't so much of a workaround and that works correctly against that edge case.
Edit:
The accepted answer has the best solution in my opinion out of all the current answers. I have modified it for my needs and preference to the following code in the workbook:
Private WorkbookClosing As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
WorkbookClosing = True
End Sub
Private Sub Workbook_Deactivate()
If WorkbookClosing And ThisWorkbook.Name = ActiveWindow.Caption Then
Workbook_Closing
Else
WorkbookClosing = False
End If
End Sub
Private Sub Workbook_Closing()
MsgBox "Workbook_Closing event."
End Sub
This is an evolution of my 1st Answer - it detects the edge case problem by comparing the ActiveWindow.Caption against ThisWorkbook.Name so it can detect that issue and deal with it. It's not the most elegant solution but I believe it works.
All Code in the Workbook most of it in DeActivate
Public ByeBye As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ByeBye = "B4C"
End Sub
Private Sub Workbook_Deactivate()
If ByeBye = "B4C" Then
If ActiveWindow.Caption = ThisWorkbook.Name Then
If ThisWorkbook.Saved Then
MsgBox "No problem - Closing after Saving"
Else
MsgBox "No problem - Closing without Saving"
End If
Else
If ThisWorkbook.Saved Then
MsgBox "No problem - New Workbook Activation"
Else
MsgBox "Oops Try Again You Cannot Activate '" & ActiveWindow.Caption & "' until '" & ThisWorkbook.Name & "' has completed processing & IT HAS NOW COMPLETED", vbOKOnly, "Hiding"
ThisWorkbook.Activate
End If
End If
Else
MsgBox "No problem - Just Hiding"
End If
ByeBye = "Done"
End Sub
Private Sub Workbook_Open()
ByeBye = "OPENED"
End Sub
In response to comment about saving I tested this for 7 possible combinations as follows
1) Closing without Edits - No Saving Involved ... MsgBox Prompted with ... No problem - Closing after Saving
2) Not closing - Just Switch Workbook - Whether Edited or Not ... MsgBox Prompted with ... No problem - Just Hiding
3) Not closing - Switch Workbook - After Edit & Cancel ... MsgBox Prompted with ... Oops Try Again …
4) Closing and saving ... MsgBox Prompted with ... No problem - Closing after Saving
5) Closing and Saving after a prior Cancel ... MsgBox Prompted with ... No problem - Closing after Saving
6) Closing but Not Saving ... MsgBox Prompted with ... No problem - Closing without Saving
7) Closing but not Saving after a prior Cancel ... MsgBox Prompted with ... No problem - Closing without Saving
I think trying to cancel the close event is the wrong approach for what you are trying to do. A better approach would be to have a function that is only called when the workbook is actually closing.
Thank you for the comments regarding OnTime not being called while the dialog is open as that pointed me in the right direction. What we need to test is the time between the workbook deactivation and the closing of either the workbook itself or the save dialog. Using the Excel.Application.OnTime function to set this close time means this is possible as it can be delayed until the save dialogue has closed.
Once we have this time, a simple comparison to the deactivation time allows us to decide whether to call the exit function or not.
I initially ran into issues with the workbook reopening to run the .OnTime procedure, so an artificial delay needs to be added into the Deactivation function so the workbook hasn't closed until the close time has been set. Using the code from here - Delay Macro to allow events to finish we can accomplish this.
In ThisWorkbook
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Excel.Application.OnTime EarliestTime:=Now, Procedure:="SetCloseTime"
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Timer < CloseTime + 0.2 Then Call CloseProcedure
End Sub
Private Sub Workbook_Deactivate()
Delay (0.3)
If Timer < CloseTime + 0.4 Then Call CloseProcedure
End Sub
In a module
Option Explicit
Public CloseTime As Single
Function SetCloseTime()
CloseTime = Timer
End Function
Function Delay(Seconds As Single)
Dim StopTime As Single: StopTime = Timer + Seconds
Do While Timer < StopTime
DoEvents
Loop
End Function
Function CloseProcedure()
MsgBox "Excel is closing"
End Function
The .OnTime seems to run within one second cycles which dictates the length of the delay and the time difference test has a little leeway added with an additional 1/10th of a second (which I found necessary). These timings could potentially need slight tweaking but have so far worked for me with the different scenarios when closing the workbook.
In order to get around your edge case, you need to handle the case where the workbook is deactivated within 1 second of closing it, but only when the save prompt was displayed.
To check if less than 1 second has elapsed, use a high resolution timer to store the time in the Workbook_BeforeClose event, and then compare against it in the Workbook_Deactivate event. Assuming that clsTimer is a suitable high res timer, your code should now be:
Private MyTimer As clsTimer
Private StartTime As Currency
Private Sub Workbook_BeforeClose(ByRef Cancel As Boolean)
closing_event = True
Set MyTimer = New clsTimer
StartTime = MyTimer.MicroTimer
check_time = VBA.Now + VBA.TimeSerial(Hour:=0, Minute:=0, Second:=1)
Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event"
End Sub
Private Sub Workbook_Deactivate()
If closing_event Then
If Not ThisWorkbook.Saved Then
'The Save prompt must have been displayed, and the user clicked No or Cancel or pressed Escape
If MyTimer.MicroTimer - StartTime < 1 Then
'The user must have pressed Escape and Alt-Tabbed
closing_event = False
Else
'Your Windows API calls here
End If
Else
'The workbook was saved before the close event, so the Save prompt was not displayed
'Your Windows API calls here
End If
Excel.Application.OnTime EarliestTime:=check_time, Procedure:="disable_closing_event", Schedule:=False
End If
Set MyTimer = Nothing
End Sub
The class module for clsTimer looks like this:
Private Declare PtrSafe Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Public Function MicroTimer() As Currency
' Returns seconds.
Dim cyTicks1 As Currency
Static cyFrequency As Currency
MicroTimer = 0
' Get frequency.
If cyFrequency = 0 Then getFrequency cyFrequency
' Get ticks.
getTickCount cyTicks1
' Seconds
If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function
This post could be helpful https://www.dummies.com/software/microsoft-office/excel/an-excel-macro-to-save-a-workbook-before-closing/
I found code below from the book Excel 2016 Power Programming with VBA, by Michael Alexander
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim msg As String, ans as integer
If Me.Saved = False Then
msg = "Do you want to save?"
ans = MsgBox(msg, vbquestion+vbyesnocancel)
Select Case ans
Case vbYes: Me.Save
Case vbCancel: Cancel = True
End Select
End If
Call mySub
Me.Saved = True
End Sub
I think deactivate is the best way to capture this.
Beforeclose might occur earlier than Save event if the document was not saved. So Excel might prompt to save before closure.
But Deactivate is the final event before closure (after save). So this can be used.
had a similar problem and tried to run some macro before closing but it is dependad whether user wants to save workbook or not.
My solution was the code below, though there is a problem, that window of excel always stays open.
Public ClosedByProgram As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not ClosedByProgram Then
Cancel = True
Dim Ans As String
Ans = MsgBox("Want to save your changes to '" & ThisWorkbook.Name & "'?", vbYesNoCancel, "Microsoft Excel")
If Ans = vbNo Then
ClosedByProgram = True
ThisWorkbook.Close
ElseIf Ans = vbYes Then
Dim STR As String: STR = "'" & ThisWorkbook.Name & "'!" & "mod16_Versioning.IsSuitableForSaving"
Dim isForSaving As Boolean: isForSaving = Application.Run(STR, SaveAsUI)
If isForSaving Then
Dim STRToRun As String
STRToRun = "'" & ThisWorkbook.Name & "'!" & "mod02_Events.BeforeSave"
Application.Run STRToRun, SaveAsUI
Dim STRVersions As String: STRVersions = "'" & ThisWorkbook.Name & "'!" & "mod16_Versioning.MakeVersion"
Dim blankCheck As Boolean: blankCheck = Application.Run(STRVersions, SaveAsUI)
ClosedByProgram = True
ThisWorkbook.Close
End If
End If
Else
ThisWorkbook.Saved = True
Application.Quit
End If
End Sub
This seems to work
Code in the WorkBook
Public ByeBye As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ByeBye = "BB # " & Now()
End Sub
Private Sub Workbook_Deactivate()
If Left(ByeBye, 2) = "BB" Then
ByeBye="Done"
MsgBox "Closing"
Else
ByeBye="Done"
MsgBox "DeActivating BUT NOT Closing"
End If
End Sub
Private Sub Workbook_Open()
ByeBye = "OP # " & Now()
End Sub
Just uses a public variable ByeBye
You must initialise it in WorkBook.Open
You must Set it in WorkBook.BeforeClose
and can test it in WorkBook.DeActivate
In case it is needed for this to work even after a VBA crash - and loss of ByeBye value I'm resetting it in the Workbook_SheetChange and in WorkBook_SheetSelectionChange
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ByeBye = "SC # " & Now()
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ByeBye = "SSC # " & Now()
End Sub
The above addendum is really only needed if you were going to use the string default of "" for the tested value - but I'm using "BB # " & Now() so this is not really needed
Inherited a rather large selection of spreadsheets for multiple clients.
Some of these have multiple ThisWorkbooks (e.g. ThisWorkbook, ThisWorkbook2, etc...).
Trying to put some event code check to automatically run when the workbook is opened. Either Workbook or App Events could be a solution.
The recommendation from http://www.cpearson.com/Excel/AppEvent.aspx suggests adding something like the following code to ThisWorkbook.
Private XLApp As CExcelEvents
Private Sub Workbook_Open()
Set XLApp = New CExcelEvents
End Sub
The issue is that if there are multiple ThisWorkbooks, the code never runs.
Actually, testing shows if I put it into ThisWorkbook1, it runs from there. LOL.
Main Question: Is there an event to create an Application Events object that doesn't use ThisWorkbook when opening a spreadsheet?
Basically another "code gate" that is always guaranteed to run that doesn't require ThisWorkbook.
I suspect "No", but any confirmation or alternative would be helpful.
Thanks.
The Workbook.Open event is the modern way to get code to run on open.
The legacy way is to have a specially named macro in a standard module:
Public Sub Auto_Open()
MsgBox "Works!"
End Sub
That should pop the message box on open.
As mentioned in the comments, a sane Excel file only has a single Workbook module - there being more than one means the file is corrupted in some way, and that can't be good. I'd recommend rebuilding the broken files: you never know when a corrupted file will just outright crash Excel for no apparent reason.
Don't know why the corruption is happening, but it's happening enough across various spreadsheets to be worrisome.
Created code to test for a bad ThisWorkbook upon opening and not allow saving if ThisWorkbook is bad.
1 regular module (modAutoOpenAndClose) and 1 class module (classWBEvents).
Putting these 2 modules into all spreadsheets as standard procedure. As mentioned above in the comments, users will then follow the instructions from Excel Experts Tips to Fix Corrupt Spreadsheet.
Hopefully these are useful to anyone else experiencing/preventing corruption. May seem like overkill, but this has been a bedeviling issue.
Option Explicit
'modAutoOpenAndClose
Dim WorkbookEvents As classWBEvents
Function ErrorIsThisWorkBookBad() As Boolean
On Error GoTo ErrLabel
ErrorIsThisWorkBookBad = Not (ThisWorkbook.CodeName = "ThisWorkbook")
Exit Function
ErrLabel:
ErrorIsThisWorkBookBad = True
End Function
Private Sub Auto_Open()
If ErrorIsThisWorkBookBad Then
Call MsgBox("This Spreadsheet is Corrupt." + vbCrLf + vbCrLf + _
"Please Copy Tabs And Modules to New Spreadsheet." + vbCrLf + vbCrLf + _
"Saving will not be allowed.", vbCritical)
End If
Set WorkbookEvents = New classWBEvents
Set WorkbookEvents.WB = ActiveWorkbook
If Not WorkbookEvents.WB Is Nothing Then
WorkbookEvents.WB_Open
End If
End Sub
Private Sub Auto_Close()
If Not WorkbookEvents Is Nothing Then
If Not WorkbookEvents.WB Is Nothing Then
Set WorkbookEvents.WB = Nothing
End If
Set WorkbookEvents = Nothing
End If
End Sub
And
Option Explicit
'classWBEvents
Public WithEvents WB As Workbook
Private Sub WB_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If ErrorIsThisWorkBookBad Then
Call MsgBox("This Spreadsheet is Corrupt." + vbCrLf + vbCrLf + _
"Please Copy Tabs And Modules to New Spreadsheet." + vbCrLf + vbCrLf + _
"Saving will not be allowed.", vbCritical)
Cancel = True
End If
End Sub
Public Sub WB_Open()
'Reserved for project specific code
End Sub
I have inherited an excel project, which I’ve been tasked to automate and develop further.
Use case being
An order comes in
User opens the base (root) excel file
Types in the relevant info (customer, order, data, tasks, etc)
And saves the new task file in a folder with tasks in progress
Leaving the base (root) excel basic and ready for next order.
The new task file needs to have a certain file name structure, which has been sorted.
My problem comes in on ActiveWorkbook.SaveAs filename.
As I step through F5 the lines, it goes through all the steps, creates the filename, shows the Save As UI, correctly shows the right folder and suggested filename, and actually saves the file. As I come out of ErrHandler and the last Application.EnableEvents = yes - it crashes. It seems to either be closing the base file, opening the new, or transfer active workbook to the new save file.
Which is fine, if it could stop crashing.
If criticalInput then
Msgbox “U been bad, U Shall not PASS!”, vbCritical ‘Not actual text or box showing, just for demo.
Else
Dim fileSaveName As Variant
'### It Crashes after saving (possible at opening)
fileSaveName = Application.GetSaveAsFilename( _
InitialFileName:=tasksfolder & "\" & suggestFilename, _
fileFilter:="Excel-projectmappe med aktive makroer (*.xlsm), *.xlsm")
If fileSaveName <> False Then
'### here is where you would save your file
DoEvents ‘ Debugging research tells this should be here. Not that is changes anything.
ActiveWorkbook.SaveAs fileSaveName ‘ During dev this has been disabled.
End If ' SaveAs
End If ' criticalInput
ErrHandler:
'## Reset back to default
Application.DefaultFilePath = strDefault
Application.EnableEvents = True
End Sub
Debugging
I can save the file just nicely, if I disable SaveAs and work only on the base (root) excel file.
I can open the new task file and save it nicely. (Just being a bugger about overwriting, Y/N)
Debugging research said I needed a DoEvents prior to SaveAs
Debugging research also said only to have the most relevant references present (in my case unselect OLE Automation)
During debugging, I’ve also created, AfterSave() and Open(). They triggers normally during normal operation, but fails when SaveAs has crashed. Eg as I disable SaveAs or when I open the excel book normally.
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
On Error GoTo ErrHandler
If Success Then
Application.EnableEvents = False
'MsgBox "Success save", vbInformation ' for debugging purposes.
End If
ErrHandler:
Application.EnableEvents = True
End Sub
Private Sub Workbook_Open()
'MsgBox "I haz been opened, yehawww", vbInformation ' debugging
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim fname As Variant, DateTime As String, myInitialFilename As String
On Error GoTo ErrorHandler
SaveAsUI = True
If SaveAsUI Then
Cancel = True 'Cancel the original SaveAs
DateTime = "_" & Format(Now(), "yyyy_mm_dd_hhmmss") '= " [yyyy_mm_dd]"
'DateTime = " [" & Format(Now(), "yyyy_mm_dd hhmm_ss") & "]" '= " [yyyy_mm_dd hhmm_ss]" (use instead if you want time in the name)
myInitialFilename = "Quote" 'EDIT THIS
'Get filename (with path) for saving
fname = Application.GetSaveAsFilename(InitialFileName:=myInitialFilename & DateTime, fileFilter:="Excel Marcro-Enabled Workbook (*.xlsm),*.xlsm")
If fname = False Then Exit Sub 'Exit if user hit Cancel
Application.EnableEvents = False 'Prevent this event from firing
ThisWorkbook.SaveAs Filename:=fname, FileFormat:=52
'52 = xlOpenXMLWorkbookMacroEnabled = xlsm (with macro's in 2007-2010)
Application.EnableEvents = True 'Re-enable events
End If
Exit Sub
ErrorHandler:
Application.EnableEvents = True
MsgBox "An error occured during save." & Err.Number, vbCritical, "Error"
End Sub`
I have written a bit of VBA code to force a save or save-as to be the file type .xlsm, which works fine. However, I can't seem to save the template file with the VBA code in it because of the code itself forcing the .xlsm save.
I have a template saved without the code, but as soon as I add the code, obviously I can no longer save as xltm, since the code pushes to save as xslm. Looking for a best practice solution to save my template!
Thanks,
Kathy B.
Any changes within the file will either make it always save as xltm, or always as xlsm. So you want a flag stored in a different file, which defaults to false. This way, when you want to edit your template, you can turn it on and save your changes, but in normal usage, it will save as .xlsm.
If you do not overwrite the SaveAsUI-Flag with true
you can save the file as Template when you work on it.
If you create a new File form the Template the
SaveAsUI-Flag will be true and then your code forces
to keep the macros.
I have the following piece of code which i have written in excel vba to control the On_Close event of any excel workbook. I have written the code as a Excel add-in and hence it gets loaded for all open excel workbooks.
The objective of the addin to find on close event (rather before close), that if the workbook was saved in a certain path, then it should alert the user with some custom prompts, else do nothing.
The issue is that though the event fires correctly, it fires multiple times (3 mostly) and I cant find the possible reason for this. I have translated the same code in Word VBA and it seems to run fine there.
I have a standard module: "savefromtemp"
code
Option Explicit
Dim oAppClass As New ThisApplication
Sub Auto_Open()
Set oAppClass.oApp = Application
End Sub
I have a Class module: ThisApplication
code
Option Explicit
Public WithEvents oApp As Application
Private Sub oApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
MsgBox "abt to close"
Dim iRet As Integer
Dim sFolderName As String, fDialog As FileDialog, ret As Long
'Debug.Print ActiveWorkbook.FullName
If InStr(1, ActiveWorkbook.FullName, "C:\Users\" & Environ("username") & "\SDocuments\") Then
iRet = MsgBox("Blah Blah Blah. Do you want to save this file to different location?", vbOKCancel, "Alert")
If iRet = vbOK Then
Set fDialog = Application.FileDialog(msoFileDialogSaveAs)
ret = fDialog.Show
If ret <> 0 Then
sFolderName = fDialog.SelectedItems(1)
'MsgBox sFolderName
If sFolderName = "" Then
MsgBox "Failed to save. Please check!"
End If
' Else
' MsgBox "User pressed cancel"
End If
Set fDialog = Nothing
ElseIf iRet = vbCancel Then
End If
End If
End Sub
Because this is an Application level event handler, when you close the excel application itself, it fires for all open workbooks, including any AddIn's.
You will need to test if the closing workbook is one you want to handle
Note: when I tested it, closing a single workbook calls the event only once for me.