Solved

Do...While Loop

Posted on 2011-05-09
5
281 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
ID: 35726416
0
 
LVL 39

Accepted Solution

by:
Pratima Pharande earned 125 total points
ID: 35726427
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
ID: 35727569
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
ID: 35737902
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
ID: 35743987
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

Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

Question has a verified solution.

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

Suggested Solutions

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…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…

919 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

18 Experts available now in Live!

Get 1:1 Help Now