Help with creating Excel VBA Password system

[zkm1223]

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.

[snb]

You don't need one.

Check the user's username; that may suffice.

in Excel:


application.Username
Environ("username")

[zkm1223]

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

[Paul_Hossler]

this might get you started

PIN = 1234

Little brute force, and could stand some eye candy

Paul

[Aussiebear]

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

[Paul_Hossler]

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

(or did I misunderstand ???)

Paul

[zkm1223]

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

[Aussiebear]

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

[Paul_Hossler]

Me????


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

[Aussiebear]

:hide: