I have an Excel file that as several functionalities in vba. One of those is some background savings at some points. For that matter, the file must be able to write, or in other words, it cannot and should not function if its open as a readonly.
Hence my question: can I, and how, control the readonly (or notify) alert message, so that once the file is opened, it can warn (msgbox or form) that the file is opened, but prevent from going futher (like fully open as a readonly)?
There are some examples as how to check if a file is opened, from another file. This case, the file must check it self if opened, what I suspect that would render it in a loop. If the file could still retreive the user that opened the file in the first place (like the original warning), it would be great.
Thanks!
You could put a check in the Workbook_Open() event like so:
Private Sub Workbook_Open()
If ThisWorkbook.ReadOnly = True Then
MsgBox "File in use by: " & CreateObject("ADsSecurityUtility").GetSecurityDescriptor(ThisWorkbook.FullName, 1, 1).Owner & _
vbCrLf & vbCrLf & _
"Please re-open this workbook when available for write access.", vbOkOnly + vbInformation, "File Locked"
ThisWorkbook.Close SaveChanges:=False '// close if read only
End If
End Sub
Related
I am trying to validate the active workbook is the proper workbook from the proper folder in our shared drive. Otherwise, the user will save data and it will not be shared. A safety measure to ensure data entry.
Some users save a copy of the aforementioned 'active workbook' to their PC off of the shared drive, which leads to data loss.
I want to use a message box to alert the user they will not save data in the group file, then ask if they would like to open that file.
Upon hitting "Yes", the other file would open while leaving the existing document open.
The selection "No" or "Cancel" would end sub.
GOAL:
Use a message box to alert the user that they are not working on the shared document.
Upon selection, the yes button open the correct document.
CODE (in Workbook):
Private Sub Workbook_Open()
Dim Sheet1 As Worksheet
Set Sheet1 = Sheets("Invoices")
Dim folpath As String
Dim mypath As String
Application.ScreenUpdating = False
folpath = "K:\Purchasing_Utilities\1_UTILITIES\4_VENDOR_INVOICES\GHOST_CARD\Active_Pay_Tracker_22.xlsm"
mypath = Application.ActiveWorkbook.FullName
If mypath = folpath Then
GoTo Skip
Else
MsgBox "This file source is a locally saved file. To share changes, please open the Tracker in the K: drive." _
& " Would you like the system to open this file now?", VbMsgBoxStyle = vbOKCancel + vbCritical
'Here is where I am trying to get the message box to open the document
Skip
Sheet1.Range("P:P").Sort Key1:=Sheet1.Range("P:P"), Order1:=xlAscending, Header:=xlYes
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Activate
Application.ScreenUpdating = True
Just an example:
Result = MsgBox("This file source is a locally saved file. To share changes, please open the Tracker in the K: drive. Would you like the system to open this file now?", vbOKCancel + vbCritical)
If Result = vbOKCancel Then
MsgBox "You clicked OK"
Else: MsgBox "You clicked Critical"
End If
This looks as follows:
If you press "Ok", this is what you see:
So, if you want a vbYes, you'll need to add this to the original messagebox (which currently does not have a "Yes" button) and add the corresponding Result handling (if Result = vbYes then ... (open file)).
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 one excel file that opens other excel files using VBA. These other excel files all run code on open — currently when the main file opens a file, it waits for the on open code to run in the file it just opened, and then opens the next file. I would like it to just open the files then move on to opening the next file without waiting for the on open code to finish — (I plan on limiting the number of files it has open at a time using process IDs) — any tips?
First you disable the run of macros, open the workbooks as you need them and then you reenable the run of macros. (as proposed here: Getting a .xlsm file to not execute code when being opened with VBA)
Private Sub OpenWorkBookMacroDisabled(wbPath As String)
Application.AutomationSecurity = msoAutomationSecurityForceDisable
Workbooks.Open (wbPath)
Application.AutomationSecurity = msoAutomationSecurityByUI
'or
'Application.AutomationSecurity = msoAutomationSecurityLow
End Sub
But actually this does not solve your problem. To run the macros it would be necessary to reopen the workbooks which then would again autostart the individual macros.
Workaround 1
A possible solution is mentioned here: https://www.ozgrid.com/forum/forum/help-forums/excel-general/47477-enabling-macros-without-re-opening-worksheet:
CREATE AN ENABLE/DISABLE VALIDATION CELL
The only work around if it was a problem could be something like a validation cell on your home / front page that said " enabled" / "disabled".
Then when opening the workbook always enable the macro's, then on workbook open auto set this to disabled.
then you would have all macros look at this ref and if disabled not run, and you would need to dial up enabled to allow any macro to run.
May not be what you want but a thought.
Workaround 2
Another workaround could be:
(1) Open the workbook(s) with the code mentioned above.
(2) Change Sub Workbook_Open to Sub Workbook_Open_OLD programmatically
(3) Save the workbook(s)
(4) Change AutomationSecurity to the desired level
(5) reopen your workbook(s)
Quite a lot of work!
For details see: http://www.cpearson.com/excel/vbe.aspx
Workaround 3
A variation to the enable/disable validation cell is the use of a central property
e.g. Application.Username
**This Macro calls the 'other excel files':**
Sub Main0()
'TEST 1:
'Open workbook and DON'T run macros
'Call "YourCode" manually
Application.UserName = "NoMacroRun"
Debug.Print "Test 1:"
Debug.Print Application.UserName
Workbooks.Open ThisWorkbook.Path & "\macro_010.xlsb"
Debug.Print "Open finished"
Debug.Print "Call YourCode"
Run "macro_010.xlsb!YourCode"
Workbooks("macro_010.xlsb").Close SaveChanges:=False
Debug.Print "Test 1: FINISHED successfully"
Debug.Print ""
'TEST 2:
'Open workbook and run macros
Application.UserName = "SomeThingElse"
Debug.Print "Test 2:"
Debug.Print Application.UserName
Workbooks.Open ThisWorkbook.Path & "\macro_010.xlsb"
Debug.Print "Test 2: FINISHED successfully"
Debug.Print ""
Workbooks("macro_010.xlsb").Close SaveChanges:=False
Debug.Print ""
End Sub
The other files look like:
In 'the other files' you seperate "YourCode" from "Workbook_Open" and make it callable from the outside:
'doubleclick "ThisWorkbook" in the IDE and insert this code there
Public Sub Workbook_Open()
If Application.UserName <> "NoMacroRun" Then
Debug.Print "---> " & ThisWorkbook.Name & ": Workbook_Open is part of ThisWorkbook in the IDE"
'your code
Call YourCode
End If
End Sub
This code you insert into a module:
'doubleclick "module" in the IDE and insert this code there
'OR click in the menu --> Insert --> Module
Sub YourCode()
Debug.Print "---> " & ThisWorkbook.Name & ": ""Sub YourCode"" is part of a module in the IDE!"
End Sub
And finally, the Immediate Window proves that it works as intended:
Test 1:
NoMacroRun
Open finished
Call YourCode
---> macro_010.xlsb: "Sub YourCode" is part of a module in the IDE!
Test 1: finished successfully
Test 2:
SomeThingElse
---> macro_010.xlsb: Workbook_Open is part of ThisWorkbook in the IDE
---> macro_010.xlsb: "Sub YourCode" is part of a module in the IDE!
Test 2: finished successfully
Q.E.D. ;-)
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'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/