Im working on building out a VBA-based app that will have around 150 users. They will all have their own data files, tables, custom views, etc. But I will need to regularly update the code behind the app. So Im using the two-workbook technique where their unique User Workbooks (call them the UWs) all pass control to a Code Workbook (call it CW) which contains all the code. That way, when I need to update, I update the CW, and everyone simply replaces the old CW in their folders with the new one and their UWs remain the same.
My problem is that I'd like the CW to essentially remain hidden and protected. But with macro security, when they open their UWs after the update and it immediately calls the startup subroutine in the new CW, it won't run. They have to first open the CW (which I don't want!) and make it a trusted document before opening their UWs will run the startup subroutine in the CW.
It shouldn't matter, but here is the only code in the UWs (note this is still in prototyping/early stages so everything is called 'Test'!):
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Workbooks("Test CW.xlsm").Close
End Sub
Private Sub Workbook_Open()
Application.ScreenUpdating = False
'Checks to see if TestCW is present next to Test UW
On Error Resume Next
X = Workbooks("Test CW.xlsm").Name 'Sets X to name of workbook; if its not there this will throw an error and Err <> 0
If Not (Err = 0) Then 'If there's no error
On Error GoTo CWFileError
Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Test CW.xlsm" 'Opens Test CW if in same folder
'Makes Test CW hidden
Workbooks("Test CW.xlsm").Windows(1).Visible = False
End If
On Error GoTo 0
'Runs test module in Test CW, then returns control to here
With Application
.ScreenUpdating = True
.Run "'Test CW.xlsm'!ThisWorkbook.TestStart" 'Uses ThisWorkbook.TestSTart as TestStart is a Workbook-level subroutine in the ThisWorkbook module
End With
ThisWorkbook.Activate
Exit Sub
CWFileError:
MsgBox "Your SVEDash application file named Test CW is not in this folder." _
& vbCrLf _
& "Please locate your current SVEDash application file and place it in this folder." _
& vbCrLf _
& "This file will close to prevent damage to your data."
On Error GoTo 0
ThisWorkbook.Close
End Sub
Any ideas on how I can bypass this security issue without the users having to change their security settings?
This seemed to only be an issue with the first 'Updte'. As I copied newer 'updated' CW into the folder, as long as I kept the name consistent the previous trusted status of the former file with that name was remembered. Hopefully thats an actual solution
Related
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'm working on vba and I would like to know how to change the access mode of a workbook that is open in read-only mode in read/write mode and continue with other instructions afterwards.
I managed to change the access mode except that it does not execute the following as instructions.
Thank you.
Sub RW()
If ThisWorkbook.ReadOnly Then
ThisWorkbook.Saved = True
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
End If
MsgBox "ok"
End Sub
More Sophisticated Version of your Code:
Take a look at the info present at this link about the function .ChangeFileAccess.
Sub RW()
If ThisWorkbook.ReadOnly Then
MsgBox "Access Changed from Read Only to Read/Write"
ThisWorkbook.Saved = True
ThisWorkbook.ChangeFileAccess Mode:=xlReadWrite
Else: MsgBox "No Access Changed"
End If
End Sub
I think the issue should be with Activeworkbook & Thisworkbook
Another Suggestion ... Read About Personal MacroWorkbook, and try and save this code in that, so you can use it efficiently and by defining proper references.
Microsoft states in its "Workbook.ChangeFileAccess Method" when you switch from a workbook that is opened ReadOnly to ReadWrite, that Excel needs to retrieve a new copy of the same workbook from disk, thus opening a new version of the file.
Given that this is the case, you would need to implement the code in the On_Open procedure of your workbook. Because this is the case, you will need to inform the user prior to doing the procedure that the status will be changed.
Note: if someone openes the workbook after it is sent in an email (just as an example) or any other way in which the file is not yet saved on disk, this may cause an error.
Private Sub Workbook_Open()
If ActiveWorkbook.ReadOnly Then
MsgBox "Access will be changed from Read Only to Read/Write." & _
vbNewLine & "The file will reopen in ReadWrite mode."
ActiveWorkbook.Saved = True
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
Else: MsgBox "No Access Changed"
End If
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
I'm trying to use the following code to open a password protected file if the Windows user is "bhope" or "jdean" and display a message box if the user is anyone else. It opens the file as needed when the user is "bhope" or "jdean" but if another user clicks the button, nothing happens/no error. What am I missing?
Sub Button1_Click()
Dim wb As Workbook
Dim strUser As String
strUser = Environ("USERNAME")
Application.ScreenUpdating = False
Select Case strUser
' Full Workbook Access
Case Is = "bhope", "jdean"
If ActiveWorkbook.ReadOnly Then _
Set wb = Workbooks.Open(Filename:="M:\...", Password:="TEST")
' Limit Access
Case Is = "mjackson" 'also tried "Case Is <> "bhope", "jdean"
If Not ActiveWorkbook.ReadOnly Then _
MsgBox ("This button is reserved for SAMs")
End Select
Application.ScreenUpdating = True
End Sub
If it helps, I used this link to start the base of the code and tried to modify it from there. Thanks and cheers!
Your use of IS here may be the culprit. At best it's superfluous, at worse it's masking this issue. Instead try:
Sub Button1_Click()
Dim wb As Workbook
Dim strUser As String
strUser = Environ("USERNAME")
Application.ScreenUpdating = False
Select Case strUser
' Full Workbook Access
Case "bhope", "jdean"
If ActiveWorkbook.ReadOnly Then _
Set wb = Workbooks.Open(Filename:="M:\...", Password:="TEST")
' Limit Access
Case "mjackson"
If Not ActiveWorkbook.ReadOnly Then _
MsgBox ("This button is reserved for SAMs")
End Select
Application.ScreenUpdating = True
End Sub
Also consider changing that second CASE to CASE ELSE.
The other thing is that your msgbox is inside of your IF condition. strUser must be uqual to mjackson AND the ActiveWorkbook (whatever that might be at the time this code executes) must NOT be ReadOnly for that msgbox to fire.
Consider changing "ActiveWorkbook" to be more specific. Perhaps ThisWorkbook.ReadOnly?
Consider an Else for your if statement to see if the mjackson is hitting but the readonly is not:
Case "mjackson"
If Not ActiveWorkbook.ReadOnly Then
MsgBox ("This button is reserved for SAMs")
Else
MsgBox ("ActiveWorkbook is not Read Only so yo get this message")
End If
Lastly, put a breakpoint (F9) on SELECT and see what your value of strUser as while the code is running (hover over strUSer on that line or check your Locals pane). You may also want to see what ActiveWorkbook is at this point of time too, just in case. The answer will, again, be in your Locals pane, so make sure that is turned on in the view drop down of VBE.
I figured out the solution. Apparently the "case else" I said I tried earlier was actually done to another test file with similar code as I usually have several open when I'm testing to compare behaviors. I also had to delete the line below "case else" so that only the msg box line would run after that. Below is the code I used should anyone need it in the future:
Sub Button1_Click()
Dim wb As Workbook
Dim strUser As String
strUser = Environ("USERNAME")
Application.ScreenUpdating = False
Select Case LCase(strUser)
' Full Workbook Access
Case Is = "bhope", "jdean"
If ThisWorkbook.ReadOnly Then _
Set wb = Workbooks.Open(Filename:="M:...", Password:="TEST")
' Limit Access
Case Else
MsgBox ("This button is reserved for SAMs")
End Select
Application.ScreenUpdating = True
End Sub
To answer earlier questions: my understanding of screen update is that if it's turned off, the application will run non-visually so as not to cause concern for the users who will be using this file. Also, this code makes it run faster, does it not?
As far as the purpose of the workbook and security concerns... the button will be used on a read only workbook that houses many portions of our company's metrics. The file is made read only so that users cannot save over it. Since the file is kind of big and a lot of data is expected to go into it, my thought process was to load the "Shell" of the main file then have buttons that determine who should be allowed to add info to certain sheets. By having both files read only and password-protected, I'm able to open the 2nd sheet when the appropriate user clicks the button, then have data transfer back and forth between the workbooks. I still intend on password protecting the VBA code so I don't see how their could be a security concern. Also, #ashleedog, I meant that everyone in our company has lower case user names.
I need a simple error handling code for my small macro, I have search the web but have nothing simple, seems to be all very complicated.
I down load sales reports in .txt form on a weekly basis, I run separate macro to do stuff and then add to a master page. Not every week do sales reports download as there may not have been sales for that particular region.
I need a simple error handler so that if it does not find the report, it moves to the next sub.
Any help appreciated
Sub MXM_POS()
Workbooks.OpenText Filename:="C:\Users\903270\Documents\Excel\MXMPOS*.txt"
‘Run macro code
Run ("DLK_POS")
End Sub
Here is a simple basic structure that you can expand on as needed:
Sub MXM_POS()
On Error GoTo ErrHandler
' code here
ExitSub:
' shutdown code here
Exit Sub
ErrHandler:
If Err.Number <> 0 Then
Dim mbr As VbMsgBoxResult
mbr = MsgBox( _
"Error #" & Err.Number & ": " & Err.Description & vbNewLine & _
"Would you like to continue?", vbExclamation Or vbYesNo)
If mbr = vbYes Then Resume ExitSub
Application.Quit
End If
End Sub
When I desire a stack dump I construct that within the Source property of the Err object using concatenation with a newline, and then only display the MsgBox result at the top of the calling stack, usually either the Event Handler that launched the code or the top-level macro invoked by the user.