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
Related
I am have limited experience in coding in VBA and have implemented some code into an excel workbook, for which I take no credit for and which I obtained via the web, so all credit to the original creator. The code forces the user to save the workbook as .xlsm. The code works fine, as shown, with a small niggle.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FileNameVal As String
If SaveAsUI Then
FileNameVal = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
MsgBox (FileNameVal)
Cancel = True
If FileNameVal = CStr(False) Then 'User pressed cancel
Exit Sub
End If
Application.EnableEvents = False
If Right(ThisWorkbook.Name, 5) <> ".xlsm" Then
ThisWorkbook.SaveAs Filename:=FileNameVal & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Else
ThisWorkbook.SaveAs Filename:=FileNameVal, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If
Application.EnableEvents = True
End If
End Sub
The niggle is that in selecting File/SaveAs, the UI presents the SaveAs dialogue box in which I type the new filename. This then creates a further SaveAs dialogue box with input for the filename again, but the inserted filename is the original current filename not the new one entered in the previous step. It seems the new entry is not carried over to the following dialogue box. Not a big issue, just more of a niggle. Is there any way to correct this please?
I had the same need with a Word Document which needed to be forced to save as a .docm. This was achieved in a different manner and all credit goes to David Zemens as answered in this post Word VBA force save as .docm. This works really well for my need. I was wondering if this type of method could be used in Excel and if so what would need to change?
Any help would be appreciated, thanks in advance.
zump
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
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
I've decided to create a pass-protected file which will self-destruct after three wrong password entries. The macro runs with the file open (UserForm with pass entry field pops up) but the weak point is that Ctrl-Break allows to stop the macro and get access to the code.
Is there any way to disable/prevent Break option in a particular workbook (via VBA, preferably)?
If you are interested, I can provide the macro upon request.
UPD: Here's the macro i'm using (Date based).
Private Sub Workbook_Open()
If Date > Cdate("30/03/2015") Then
WARNING.Show
End If
End Sub
This part of code is assigned to "Ok" and "Cancel" buttons of the UserForm "WARNING".
Public i As Integer
Public b As Integer
Sub setib()
i = 2 - b
b = b + 0
End Sub
Private Sub CnclBtn_Click()
WARNING.Hide
With ThisWorkbook
.Saved = True
.Close False
End With
End Sub
Private Sub OKBtn_Click()
Call setib
Dim Pass As String: Pass = "*your pass*"
Dim PassInput As String: PassInput = WARNING.PassField.Text
If PassInput = Pass Then
MsgBox "Password is correct"
GoTo Safe:
Else
If b < 2 Then
MsgBox "Password is incorrect. " & i & " attempts left."
Else
MsgBox "No More attempts"
End If
If b = 2 Then
WARNING.Hide
GoTo Destroy:
Else
WARNING.PassField.Value = vbNullString
WARNING.PassField.SetFocus
b = b + 1
GoTo EndSub:
End If
End If
Safe:
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.DeleteLines 1, _
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines
WARNING.Hide
GoTo EndSub:
Destroy:
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
EndSub:
Sheet1.Activate
End Sub
You could simply password-protect the VBA project. That will avoid the need to worry about playing with the Application-level settings for EnableCancelKey.
While the user may be able to "break" with the cancel key, they will not be able to view the code without supplying the proper password for the VBA project.
With the VBAProject protected, the user can "break" execution of the code, the user should not be able to enter "break mode", and the Excel application will not be interactive (so the user will not be able to access the worksheets). At this point, the User Form will be frozen on the screen and the application unresponsive. The user then has two options that I can see:
If they know the name of the userform, they could conceivably Unload UserForm1 from the Immediate window in the VBE. So, you should pick some name for the UserForm which they will not likely guess. If they do this, they will be able to access the file itself, but if you give the UF a secure name, they'll never guess it correctly.
Otherwise, they're SOL, unless they Ctrl+AltDel, and kill the Excel application procdess.
NOTE: Excel passwords, whether on the worksheets or the VBAProject (or both) can be cracked by anyone intent on doing so, and are only a good measure to prevent inadvertent corruption or manipulation of the data.