Help with creating Excel VBA Password system

Hi,

I am trying to create a password system in Excel using VBA. I need it to ask for the password, allow up to 3 attempts to enter the correct password which is "password", once the correct password is entered, I need it to ask for a 4 digit pin which needs to be entered one digit at a time and a message appears when each digit is entered to confirm the digit.

Also I need it to use a while loop in the coding.

I have attached my excel document. So far I have managed to make it enter the password allowing 3 attempts. But I do not know how to do the rest. Please help.

You don't need one.

Check the user's username; that may suffice.

in Excel:

[vba]
application.Username
Environ("username")

[/vba]

I don't understand what you mean. I need the system to ask for a 4 digit pin number.

this might get you started

PIN = 1234

Little brute force, and could stand some eye candy

Paul

Even when its the correct Pin, it shows the message Too Bad!.

Well .. north of the equator, it seems to work :beerchug:

(or did I misunderstand ???)

Paul

Thanks a lot :) it works fine and has helped me a lot. Thanks again :)

.... its that anti-Aussiebear function you have running :devil2:

Me????

[VBA]
Option Explicit

Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long

Public Const LOCALE_USER_DEFAULT As Long = &H400
Public Const LOCALE_SENGCOUNTRY As Long = &H1002


Sub AussiebearTrap()
If LCase(GetInfo(LOCALE_SENGCOUNTRY)) = "australia" And Environ("USERNAME") Like "*bear*" Then
If Rnd() < 0.9 Then
Call SpringBearTrap
Application.Quit
End If
End If
End Sub



Private Function GetInfo(ByVal lInfo As Long) As String
Dim Buffer As String
Dim ret As String
Buffer = String$(256, 0)
ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, Buffer, Len(Buffer))
If ret > 0 Then
GetInfo = Left$(Buffer, ret - 1)
Else
GetInfo = vbNullString
End If
lbl_Exit:
Exit Function
End Function



Private Sub SpringBearTrap()
Call MsgBox("Hello down under", vbCritical + vbOKOnly, "Bear Trap")
End Sub
[/VBA]

:hide: