PDA

View Full Version : Write Res Password - Force ReadOnly unless Macros Enabled



magelan
04-25-2013, 01:18 PM
Hi All, I'm trying to force the user to have macros enabled in order to run the workbook in write mode. So far i've got it successfully... I have a writerespassword on the workbook so that when the user opens it, they hit readonly. IF macros are enabled, it runs "changefileaccess" and switches to ReadWrite. I've also got it so that if the user hits the SAVE button, it saves it with the WriteRes password! HOWEVER I cannot figure out how to make it so that if the user quits without saving, it keeps the writerespassword. I have a beforeclose macro but it doesnt seem to do anything because the document isnt saved. I reall need to be able to force the writeres password back onto the document if they quit without saving. Plz Halp

snb
04-26-2013, 03:33 AM
Add this to the workbook:


Private Sub Workbook_Open()
Saved = False
End Sub

magelan
05-02-2013, 07:11 AM
saved=false did nothing - if I open the workbook, let it grant me Write permissions, and then close it, it doesnt put the writeres password back on =(

Kenneth Hobs
05-02-2013, 07:14 AM
In ThisWorkbook object:
'Ken Puls, http://www.vbaexpress.com/kb/getarticle.php?kb_id=379
' To protect by username see: http://www.vbaexpress.com/forum/showthread.php?t=42730
Option Explicit

Const WelcomePage = "Macros"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If

'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True

'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_Open()
'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False

'Record active worksheet
Set aWs = ActiveSheet

'Hide all sheets
Call HideAllSheets

'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
End If

'Restore file to where user was
Call ShowAllSheets
aWs.Activate

'Restore screen updates
Application.ScreenUpdating = True
End Sub

Private Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet

Worksheets(WelcomePage).Visible = xlSheetVisible

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws

Worksheets(WelcomePage).Activate
End Sub

Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

magelan
05-02-2013, 07:24 AM
In ThisWorkbook object:
'Ken Puls, http://www.vbaexpress.com/kb/getarticle.php?kb_id=379
' To protect by username see: http://www.vbaexpress.com/forum/showthread.php?t=42730
Option Explicit

Const WelcomePage = "Macros"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If

'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True

'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_Open()
'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False

'Record active worksheet
Set aWs = ActiveSheet

'Hide all sheets
Call HideAllSheets

'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
End If

'Restore file to where user was
Call ShowAllSheets
aWs.Activate

'Restore screen updates
Application.ScreenUpdating = True
End Sub

Private Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet

Worksheets(WelcomePage).Visible = xlSheetVisible

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws

Worksheets(WelcomePage).Activate
End Sub

Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub


Hmm..im not sure you saw the original post, but I require a WriteResPassword as the workbook should only ever be opened with Macro's enabled. I have a random md5 hash being used as the writerespassword so that only the program can open itself with write permissions. I have it such that the workbook is perfectly fine and great if you open it read only with macros enabled - the macros will automatically grant you write permissions. If you then save and quit the workbook, you can open it again, and the password prompt comes up. However, if you open the workbook as read only, get write permissions via code, and then -close without saving- the file doesnt have its writerespassword reinstated. I would stick a workbook.save in beforeClose but i would be afraid of someone opening the workbook, hitting Control-A , Delete, and not havingt any way of getting the workbook back.

magelan
05-02-2013, 11:00 AM
Sub Workbook_BeforeClose(cancel As Boolean)
KillOnTime 'kill the timer for expiration
ActiveSheet.Protect Password:="123"
Application.DisplayAlerts = False
cancel = False
ActiveWorkbook.ChangeFileAccess xlReadOnly
End Sub

Sub Workbook_Open()
Saved = False
Application.DisplayAlerts = False
If ActiveSheet.ProtectContents = True Then
ActiveSheet.Unprotect Password:="123"
End If
Application.OnTime Now + TimeValue("00:00:05"), "timermodule.timeouthappened"
Dim wb As Workbook
Set wb = ActiveWorkbook
If ActiveWorkbook.ReadOnly Then
wb.ChangeFileAccess xlReadWrite
MsgBox "Write Permissions Granted"
End If
End Sub

Sub resetTimer()
Call Workbook_Open
End Sub

Private Sub workbook_BeforeSave(ByVal saveasui As Boolean, cancel As Boolean)
Application.DisplayAlerts = False
ThisWorkbook.SaveAs filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Name, writerespassword:="12345"
End Sub

This is what I have so far, for reference. I cant find out how to re-get that writerespassword

snb
05-02-2013, 12:36 PM
Maybe ?


Sub Workbook_Open()
Application.DisplayAlerts = False
with ThisWorkbook
.SaveAs .Path & "\" & .Name, 56, writerespassword:="12345"
If .ReadOnly Then .ChangeFileAccess xlReadWrite
MsgBox "Write Permissions Granted"
end with

Saved = False
If ActiveSheet.ProtectContents Then ActiveSheet.Unprotect "123"

Application.OnTime Now + TimeValue("00:00:05"), "timermodule.timeouthappened"
End Sub

magelan
05-02-2013, 01:55 PM
Maybe ?


Sub Workbook_Open()
Application.DisplayAlerts = False
with ThisWorkbook
.SaveAs .Path & "\" & .Name, 56, writerespassword:="12345"
If .ReadOnly Then .ChangeFileAccess xlReadWrite
MsgBox "Write Permissions Granted"
end with

Saved = False
If ActiveSheet.ProtectContents Then ActiveSheet.Unprotect "123"

Application.OnTime Now + TimeValue("00:00:05"), "timermodule.timeouthappened"
End Sub The only change in there that I saw was the Saved = False. I tried that just now in exactly that place and it didnt work - doesnt make the workbook open with a writres password.

snb
05-02-2013, 02:34 PM
I used
Sub tst()
ThisWorkbook.SaveAs "G:\OF\wacht_woord.xlsm", 52, , "abc"
End Sub

Every time I open the workbook (no matter being saved or not), I will be asked to enter the password.
So I really do not understand what is your problem.

mdmackillop
05-03-2013, 01:08 PM
KB Item here (http://www.vbaexpress.com/kb/getarticle.php?kb_id=578) may be of use

magelan
05-08-2013, 09:32 AM
KB Item here (http://www.vbaexpress.com/kb/getarticle.php?kb_id=578) may be of use I actually saw that before - and thats great, but I need to lock down the workbook so that it is Read Only and therefore accessible by other people .

This whole issue started with someone opening the workbook and walking away from their computer for a day - noone else could get in to the WB and do work, so I coded a timer that would close the workbook automatically.

The only problem is that timer requires macros.. and the macro page is a great idea, BUT they can simply open the workbook with write access and leave it at the macro page and still inhibit everyone from using the workbook.

So i coded in the writerespassword. None of the users know the password, they open the workbook as "read only" and the macros, using change fileaccess, turn it to Write Enabled [and also enabled my timer].

The problem is, if they go Write Enabled, and then close without saving, the workbook becomes stuck as being read/writeable and no longer asks for the password when you open it.

magelan
05-13-2013, 06:31 AM
I guess this really isnt possible then =/