Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1055
  • Last Modified:

VBA Excel 97: Worksheet/book Protection with Password ?

No, _not_ another question about password cracking....

Do you know a way in VBA to determine whether the  worksheet / workbook protection was done with or without (i.e. left blank) a password ?

If not: Do you know a way how to catch the return of the password prompting dialog which Excel pops up when you try to unprotect by VBA a worksheet without passing the required password ?

Background: The auditing arrows are very handy, but for some reason they do not work on a protected worksheet. I am making a work-around macro and I want it to re-apply the password at the end if one was present. A fixed dialog is too cumbersome, personally I never use a password (crackers costing ~20$), but some users do.
0
cri
Asked:
cri
  • 5
  • 3
  • 2
1 Solution
 
bruintjeCommented:
Hi Cri,

this is for Word but i thought it might interest you anyway

http://groups.google.com/groups?hl=nl&selm=%232lWCHyhBHA.2372%40tkmsftngp04&rnum=11

:O)Bruintje
0
 
tureCommented:
Cri and Bruintje,

How about this function?

Function HasPassword(ws As Worksheet) As Boolean
  If ws.ProtectContents = True Then
    'If it is protected, try to unprotect it
    On Error Resume Next
    ws.Unprotect
    On Error GoTo 0
   
    If ws.ProtectContents = True Then
      'If still protected, it has a password
      HasPassword = True
    Else
      'If not protected now, it had no password
      HasPassword = False
      'Protect sheet again
      ws.Protect
    End If
  Else
    'If it wasn't protected to start with, it has no password
    HasPassword = False
  End If
End Function

Ture Magnusson
Karlstad, Sweden
0
 
bruintjeCommented:
dirty, really dirty ;)
0
NEW Veeam Backup for Microsoft Office 365 1.5

With Office 365, it’s your data and your responsibility to protect it. NEW Veeam Backup for Microsoft Office 365 eliminates the risk of losing access to your Office 365 data.

 
tureCommented:
:-D
0
 
criAuthor Commented:
bruintje: But it works....

ture: 'This' comming from you makes me almost sure there is no neater way.

Nonetheless: Assuming I do not want to probe first: Is there a way to intercept/copy the return of the default password entry dialog which will pop up if not overruled by the 'Resume Next' ? Strictly speaking I do not need to know whether there was a password, I want to ensure that the password is automatically re-applied afterwards.  
0
 
criAuthor Commented:
ture, an update ?
0
 
tureCommented:
Sorry, ri... Will look into this tomorrow.

/Ture
0
 
tureCommented:
Cri,

I have posted a workbook for you here:
http://www.turedata.se/exex/HelpCriWithProtection.xls

The workbook contains a module (Module1) and a userform (frmPassword).

The caption of the userform is set to "Unprotect worksheet"

The userform has four controls on it:

A label:
  Name: Label1
  Caption: "Password:"

A textbox:
  Name: txtPassword
  PasswordChar: "*"
  SelectionMargin: False

Two buttons:
  Name: cmdOK
  Default: True

  Name: cmdCancel)
  Cancel: True


Here is the code used:

***** In Module1:

Option Explicit

'Module level variables
'These variables are accessible from all procedures
'in this module and they keep their values between
'procedure calls
Dim strPassword As String
Dim ReProtect As Boolean

Sub RunMe()
 
  'This procedure unprotects the sheet (if necessary),
  'writes the current date and time to cell B2
  'and protects it again (if necessary) with the same
  'password that it was initially protected with
 
  Call UnprotectSheet
  If strPassword = "<Cancel>" Then Exit Sub
  ActiveSheet.Range("B2").Value = Now
  Call ReProtectSheet

End Sub

Private Sub UnprotectSheet()

  'Declare and initialize variables
  Dim ws As Worksheet
  Set ws = ActiveSheet
  ReProtect = False
  strPassword = ""
 
  'Try unprotecting until sheet is unprotected
  Do Until ws.ProtectContents = False
   
    'Ask for a password if there is one
    If HasPassword(ws) Then
      frmPassword.Show
      strPassword = frmPassword.Tag
      If strPassword = "<Cancel>" Then Exit Sub
    End If
   
    'Try unprotecting with the supplied password
    On Error Resume Next
    ws.Unprotect strPassword
    On Error GoTo 0
   
    If ws.ProtectContents Then
      'Wrong password message
      MsgBox _
        Title:="Invalid password", _
        Prompt:="An invalid password was entered. Try again.", _
        Buttons:=vbExclamation + vbOKOnly
    Else
      'Set ReProtect flag
      ReProtect = True
    End If
 
  Loop
 
End Sub

Private Sub ReProtectSheet()
 
  'Declare and initialize variables
  Dim ws As Worksheet
  Set ws = ActiveSheet
 
  'Reprotect sheet if it was initially protected
  'use the strPassword variable
  If ReProtect = True Then
    ws.Protect strPassword
  End If

End Sub

Private Function HasPassword(ws As Worksheet) As Boolean
  If ws.ProtectContents = True Then
    'If it is protected, try to unprotect it
    On Error Resume Next
    Application.DisplayAlerts = False
    ws.Unprotect ""
    Application.DisplayAlerts = True
    On Error GoTo 0
   
    If ws.ProtectContents = True Then
      'If still protected, it has a password
      HasPassword = True
    Else
      'If not protected now, it had no password
      HasPassword = False
      'Protect sheet again
      ws.Protect
    End If
  Else
    'If it wasn't protected to start with, it has no password
    HasPassword = False
  End If
End Function


***** In frmPassword:

Option Explicit

Private Sub cmdCancel_Click()
  Me.Tag = "<Cancel>"
  Me.Hide
End Sub

Private Sub cmdOK_Click()
  Me.Tag = txtPassword.Text
  Me.Hide
End Sub

Private Sub UserForm_Activate()
  txtPassword.Text = ""
  txtPassword.SetFocus
End Sub


/Ture
0
 
tureCommented:
The main reason why I use a UserForm is because InputBox doesn't provide a way to hide password characters. The form also provides a way to determine if Cancel was clicked and makes it possible to gracefully get out if that happens.

Inputbox returns the same value if Cancel is clicked as if OK is clicked with an empty input value.

/Ture
0
 
criAuthor Commented:
Ture, thank you for workbook. I have increased the points to 250.

Regarding the subquestion regarding making a copy of the _regular_ password dialog return value I will post an additional question as I want to keep my little macros as much stand-alone as possible, using too many auxiliary subs and functions make them too vulnerable to my tinkering.
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 5
  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now