Solved

Do...While Loop

Posted on 2011-05-09
5
278 Views
Last Modified: 2012-05-11
Hello Experts,

I'm using the following code found at http://support.microsoft.com/kb/209871 to password protect a form.

Private Sub Form_Open(Cancel As Integer)

   Dim Hold As Variant
   Dim tmpKey As Long
   Dim I As Integer
   Dim rs As DAO.Recordset
   Dim db As DAO.Database

   On Error GoTo Error_Handler

       ' Prompt the user for the Password.
       Hold = InputBoxDK("Please Enter Your Password", "Enter Password")
       ' Open the table that contains the password.
       Set db = CurrentDb
       Set rs = db.OpenRecordset("tblKeyCode", dbOpenTable)
       rs.Index = "PrimaryKey"
       rs.Seek "=", Me.Name
       If rs.NoMatch Then
          MsgBox "Sorry cannot find password information. Try Again"
          Cancel = -1
       Else
          ' Test to see if the key generated matches the key in
          ' the table; if there is not a match, stop the form
          ' from opening.
          If Not (rs![KeyCode] = KeyCode(CStr(Hold))) Then
             MsgBox "Sorry you entered the wrong password." & _
                "Try again.", vbOKOnly, "Incorrect Password"
             Cancel = -1
          End If
       End If
       rs.Close
       db.Close
       Exit Sub
   
Error_Handler:
   MsgBox Err.Description, vbOKOnly, "Error #" & Err.Number
   Exit Sub
End Sub

Open in new window


The code works but after one failed attempt the form opens.
How can I add a loop to prompt for the password until the right password is entered?  
0
Comment
Question by:hello_everybody
5 Comments
 
LVL 26

Expert Comment

by:Nick67
Comment Utility
0
 
LVL 39

Accepted Solution

by:
Pratima Pharande earned 125 total points
Comment Utility
Private Sub Form_Open(Cancel As Integer)

   Dim Hold As Variant
   Dim tmpKey As Long
   Dim I As Integer
   Dim rs As DAO.Recordset
   Dim db As DAO.Database

   On Error GoTo Error_Handler

       ' Prompt the user for the Password.
Do
       Hold = InputBoxDK("Please Enter Your Password", "Enter Password")
       ' Open the table that contains the password.
       Set db = CurrentDb
       Set rs = db.OpenRecordset("tblKeyCode", dbOpenTable)
       rs.Index = "PrimaryKey"
       rs.Seek "=", Me.Name
       If rs.NoMatch Then
          MsgBox "Sorry cannot find password information. Try Again"
          Cancel = -1
       Else
          ' Test to see if the key generated matches the key in
          ' the table; if there is not a match, stop the form
          ' from opening.
          If Not (rs![KeyCode] = KeyCode(CStr(Hold))) Then
             MsgBox "Sorry you entered the wrong password." & _
                "Try again.", vbOKOnly, "Incorrect Password"
             Cancel = -1
      else
Cancel = 1
          End If
       End If
       rs.Close
       db.Close
Loop While Cancel < 0

       Exit Sub
   
Error_Handler:
   MsgBox Err.Description, vbOKOnly, "Error #" & Err.Number
   Exit Sub
End Sub
0
 
LVL 8

Author Comment

by:hello_everybody
Comment Utility
pratima_mcs:

It worked like a charm. But if I click cancel it continues to loop through the code, what can I do so clicking Cancel will close the database?
0
 
LVL 1

Assisted Solution

by:Chad-M
Chad-M earned 125 total points
Comment Utility
Put Exit Sub after Cancel = 1 shown below
Else
          ' Test to see if the key generated matches the key in
          ' the table; if there is not a match, stop the form
          ' from opening.
          If Not (rs![KeyCode] = KeyCode(CStr(Hold))) Then
             MsgBox "Sorry you entered the wrong password." & _
                "Try again.", vbOKOnly, "Incorrect Password"
             Cancel = -1
      else 
Cancel = 1
Exit Sub
          End If

Open in new window

0
 
LVL 8

Author Comment

by:hello_everybody
Comment Utility
Chad-M:

Thanks for your suggestion, but it doesn't do a thing, what I did get to work is adding the following line on the last line of the loop

 
If hold = "" Then DoCmd.Quit

Open in new window


this works since the variable "hold" is an empty length string if cancel is clicked.


The only remaining issue is that the msgBox is displayed before the mdb is closed.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

QuickBooks® has a great invoice interface that we were happy with for a while but that changed in 2001 through no fault of Intuit®. Our industry's unit names are dictated by RUS: the Rural Utilities Services division of USDA. Contracts contain un…
I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.

762 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

6 Experts available now in Live!

Get 1:1 Help Now