Solved

VBA Excel 97: Worksheet/book Protection with Password ?

Posted on 2002-04-30
10
1,048 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
Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

 
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
 
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

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction Perhaps more familiar to developers who primarily use VBScript than to developers who tend to work only with Microsoft Office and Visual Basic for Applications (VBA), the Dictionary is a powerful and versatile class, and is useful …
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This video shows where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
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 …

808 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