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
Related
I am trying to run VBA code whenever a workbook closes
I tried both Private Sub auto_close() inside the Module and Private Sub Workbook_BeforeClose(Cancel As Boolean) inside "ThisWorkbook". They both work when there is a single file open but not if there are multiple files open.
The problem is that it seems that if there are several Excel files (workbooks) open at the same time, this seems to not work. Only if I close them to the point when there is only a single file open, then the code is executed
Prevent Closing Workbooks Using a Class
Note that this code goes into three different modules. I'm a newb when it comes to classes, I've only once built something similar. I don't understand when or why it stops (but sometimes it does). So if you run into trouble, ask another question (you have a class related code now) and put Class in the title and hopefully someone more qualified could answer.
The only possibly new thing for you is the third code, which has to go into a class module. Insert a new class module (Class1) and in the properties window change Class1 to wbCloser. Copy the codes into the appropriate modules and save the workbook. Then run AppEventsInit in the standard module.
Note that every time you open this workbook, AppEventsInit will run (Workbooks_Open).
ThisWorkbook
Option Explicit
Private Sub Workbook_Open()
AppEventsInit
End Sub
Standard Module e.g. Module1
Option Explicit
Public AppEvent As New wbCloser ' Class Name ('wbCloser')
Sub AppEventsInit()
Set AppEvent.App = Application
End Sub
Class Module: Class1 renamed to wbCloser
Option Explicit
Public WithEvents App As Application
Private Sub App_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Dim msg As Variant
msg = MsgBox("The workbook '" & Wb.Name _
& "' is trying to close. Will you allow it?", vbYesNo)
If msg = vbYes Then
'Cancel = False ' by default
MsgBox "You allowed closing of '" & Wb.Name & "'."
Else
Cancel = True
MsgBox "You prevented closing of '" & Wb.Name & "'."
End If
End Sub
Private Sub Class_Initialize()
' Remove if it doesn't work.
Application.Speech.Speak "Workbook Clozer Initialized"
End Sub
Try this:
After opening the VBA and inserting a module type in this:
Sub CloseAllActiveWorkbooks()
Workbooks.close
End sub
I maintain a personal workbook of Subs that I use via a Custom toolbar. I am working on a project in which there is a sub that I want to call regularly from the toolbar. But I save the workbook under development several times a day to maintain a go-back capability. Since the workbook name changes each time, the toolbar is tied to the Sub in an out of date workbook.
I want to keep a Sub in my personal macro workbook that calls a sub in the currently open workbook - any ideas how? I made it public but that didn't do it. I tried transferring the code across but it refers to variables (even global) that aren't accessible to the personal macro workbook.
Try the next approach, plese:
Create the macro to be called in the workbook which will be the active one:
Public Sub myMacroOtherWorkbook()
MsgBox "Hello from other workbook!"
End Sub
Call it from your Personal Macro Workbook, in this way:
Sub testCallMacroOtherWb()
Application.Run ("'" & ActiveWorkbook.Name & "'!myMacroOtherWorkbook")
End Sub
Version 2, in case you need to pass a parameter:
Transform the above Sub in:
Public Sub myMacroOtherWorkbook(Optional strCall As String)
MsgBox "I will bring a " & IIf(strCall = "", "", strCall) & " horse."
End Sub
Call it in this way:
Sub testCallMacroOtherWb()
Application.Run "'" & ActiveWorkbook.Name & "'!myMacroOtherWorkbook", "black"
End Sub
Note: The first call will still work, but the horse will be of no color... :)
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'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/
I was thinking it would be a nice convenience if, while a bunch of people are viewing the same workbook for read-only, they could be notified with a pop-up on their screen every time the workbook has been updated. That way they know right away what they are looking at may no longer be accurate. Thanks
Here is a crafty little way of doing what you want. The idea is to get FileDateTime(ThisWorkbook.FullName), the date the workbook file was last modified. You first get this date at the time of opening the workbook, store it in a cell in your workbook, and then check back periodically whether FileDateTime(ThisWorkbook.FullName) returns a date different from what was stored.
In this example I store the date in Sheet1.Range("A1"), but you could store it in a hidden sheet or wherever.
In your ThisWorkbook module, define the Workbook_Open event as follows:
Private Sub Workbook_Open()
userNotified = False
'Store date last modified.
dateLastModifiedWhenOpened = FileDateTime(ThisWorkbook.FullName)
'How often will we check back?
runTimeInterval = TimeValue("00:00:05")
'Set timer for next check.
Application.OnTime Now + runTimeInterval, _
"CheckWhetherThisWorkbookFileModifiedSinceOpening"
End Sub
In a code module:
Public dateLastModifiedWhenOpened As Date
Public nextRunTime As Date
Public runTimeInterval As Date
Public userNotified As Boolean
Sub CheckWhetherThisWorkbookFileModifiedSinceOpening()
If Not FileDateTime(ThisWorkbook.FullName) = dateLastModifiedWhenOpened Then
MsgBox "This workbook file has been modified since you opened it." _
& vbCrLf & "Modified at: " & FileDateTime(ThisWorkbook.FullName)
userNotified = True
Else
'Set timer for next check.
nextRunTime = Now + runTimeInterval
Application.OnTime nextRunTime, _
"CheckWhetherThisWorkbookFileModifiedSinceOpening"
End If
End Sub
It may be a good idea to clean up upon closing the workbook. In your ThisWorkbook module:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not userNotified Then
'Cancel the next check.
Application.OnTime nextRunTime, _
"CheckWhetherThisWorkbookFileModifiedSinceOpening", , False
End If
End Sub
You can share your workbook via the Review ribbon, Share Workbook.
In the advanced options you can set "Update changes" to as often as 5 minutes. In your case you probably want "Just see other users' changes".