Solved

VBA Excel 97: Worksheet/book Protection with Password ?

Posted on 2002-04-30
10
1,045 Views
Last Modified: 2012-05-04
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
Comment
Question by:cri
  • 5
  • 3
  • 2
10 Comments
 
LVL 44

Expert Comment

by:bruintje
ID: 6982773
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
 
LVL 22

Expert Comment

by:ture
ID: 6982921
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
 
LVL 44

Expert Comment

by:bruintje
ID: 6982928
dirty, really dirty ;)
0
 
LVL 22

Expert Comment

by:ture
ID: 6983083
:-D
0
 
LVL 13

Author Comment

by:cri
ID: 6984623
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
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 13

Author Comment

by:cri
ID: 6994383
ture, an update ?
0
 
LVL 22

Expert Comment

by:ture
ID: 6994779
Sorry, ri... Will look into this tomorrow.

/Ture
0
 
LVL 22

Accepted Solution

by:
ture earned 250 total points
ID: 6995891
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
 
LVL 22

Expert Comment

by:ture
ID: 6995895
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
 
LVL 13

Author Comment

by:cri
ID: 6998467
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

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

In case Office 2010 has not been deployed in your environment, this article may be quite useful. In our office, we wanted a way to deploy Microsoft Office Professional Plus 2010 through an automated batch file via logon script. This article is docum…
This article will show you how to use shortcut menus in the Access run-time environment.
This video shows the viewer how to set up and create Footnotes in their document. Click on the References tab: Select "Insert Footnote": Type in desired text:
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now