close userform after try entering username & password for three times

K

KalilMe

Active Member
Joined
Mar 5, 2021
Messages
343
Office Version
  1. 2016
Platform
  1. Windows
hi, all
I need add message when I write username and password for three times then shows message " you runout your tries sorry !" and close the userform
this is my code
VBA Code: 
Private Sub CommandButton1_Click()
Application.Visible = False
If TextBox1.Value = "123AS89" And ComboBox1.Value = "ALI" Or TextBox1.Value = "567" And ComboBox1.Value = "OMAR" Then
Me.Hide
Application.Visible = True
ThisWorkbook.Sheets("ENTER").Activate
Else
MsgBox ("THE ENTERING IS  INCORRCT")
Application.Quit

End If
End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
Here are two solutions similar to your posted code.

EXAMPLE #1 : Paste All Code in a regular module.

EXAMPLE #2 : Paste All Code in the User Form.


EXAMPLE #1 : Paste All Code in a regular module.

VBA Code: 
Option Explicit

'----------------------------------
'API CONSTANTS FOR PRIVATE INPUTBOX
'----------------------------------
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
    ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
    (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

'----------------------------------
'PRIVATE PASSWORDS FOR INPUTBOX
'----------------------------------

'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'March 2003
'////////////////////////////////////////////////////////////////////

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim RetVal
    Dim strClassName As String, lngBuffer As Long

    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If

    strClassName = String$(256, " ")
    lngBuffer = 255

    If lngCode = HCBT_ACTIVATE Then    'A window has been activated

        RetVal = GetClassName(wParam, strClassName, lngBuffer)
      
        If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox

            'This changes the edit control so that it display the password character *.
            'You can change the Asc("*") as you please.
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If

    End If
  
    'This line will ensure that any other hooks that may be in place are
    'called correctly.
    CallNextHookEx hHook, lngCode, wParam, lParam

End Function

Function InputBoxDK(Prompt, Title) As String
    Dim lngModHwnd As Long, lngThreadID As Long

    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
  
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

    InputBoxDK = InputBox(Prompt, Title)
    UnhookWindowsHookEx hHook

End Function

Sub Pwrd()
Dim x As String
Dim i As Integer

101:
     x = InputBoxDK("Enter your Password.", "Password Required")
If x = "123" Then
  'Success!
  'Continue with your macro because the user typed the correct macro
  MsgBox "Welcome!"
Else
    If i <= 1 Then
        MsgBox "Invalid Password. Try again. You have " & (2 - i) & " tries left."
        i = i + 1
        GoTo 101:
    Else
        MsgBox "Incorrect password entered too many times. Try again later."
        Application.Visible = False
        Application.Quit
      
        Exit Sub
    End If
End If
End Sub



EXAMPLE #2 : Paste All Code in the User Form.

Code: 
Option Explicit

Dim bOK        As Boolean

Dim iCounta    As Integer

Dim sPW        As String

Dim sUser      As String

Dim sMsg       As String

Const sTitle   As String = "Incorrect Password"

Const sStyle   As String = vbOKOnly + vbExclamation

Private Sub cmbValidate_Click()


    sUser = "Manager"

    sPW = "secret"

    Select Case iCounta

        Case Is = 1

            MsgBox "You have tried three time incorrectly. WorkBook will now close" _

                   , vbOKOnly + vbExclamation, "Warning"

            Application.Visible = False

            ActiveWorkbook.Close SaveChanges:=False  'close without saving

            Application.Quit
        

        Case Is <= 3

            If Me.tbxUser.Value <> sUser Or Me.tbxPW.Value <> sPW Then

                sMsg = "You have entered an incorrect Username or Password" _

                       & vbNewLine & "Try again" & vbNewLine & _

                       "You have " & iCounta - 1 & " goes left"

                MsgBox sMsg, sStyle, sTitle

                With Me

                    tbxUser.Value = vbNullString

                    tbxPW = vbNullString

                    tbxUser.SetFocus

                    iCounta = iCounta - 1

                End With

            Else

                MsgBox "Correct Information Entered.  Please Proceed.", vbOKOnly + _

                                                                        vbInformation, "Correct Information entered."

                bOK = True

                Sheet2.Activate

                Unload Me

            End If

    End Select

End Sub


Private Sub UserForm_Initialize()

    iCounta = 3

End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If bOK Then GoTo theend

    If CloseMode = 0 Then Cancel = True

    MsgBox "Sorry, you must enter your password & username", vbExclamation, "Warning"

theend:

End Sub
 
Upvote 0
thanks
but it seems there are syntax error for some lines it shows red font in example2
VBA Code: 
, vbOKOnly + vbExclamation, "Warning"
Code: 
                       & vbNewLine & "Try again" & vbNewLine & _

                       "You have " & iCounta - 1 & " goes left"
Code: 
 MsgBox "Correct Information Entered.  Please Proceed.", vbOKOnly + _
may you fix it ,please?
 
Upvote 0
Try this as a complete replacement :

VBA Code: 
Dim bOK        As Boolean

Dim iCounta    As Integer

Dim sPW        As String

Dim sUser      As String

Dim sMsg       As String

Const sTitle   As String = "Incorrect Password"

Const sStyle   As String = vbOKOnly + vbExclamation

Private Sub cmbValidate_Click()


    sUser = "Manager"

    sPW = "secret"

    Select Case iCounta

        Case Is = 1

            MsgBox "You have tried three time incorrectly. WorkBook will now close", vbOKOnly + vbExclamation, "Warning"

            Application.Visible = False

            ActiveWorkbook.Close SaveChanges:=False  'close without saving

            Application.Quit
        

        Case Is <= 3

            If Me.tbxUser.Value <> sUser Or Me.tbxPW.Value <> sPW Then

                sMsg = "You have entered an incorrect Username or Password" & vbNewLine & "Try again" & vbNewLine & "You have " & iCounta - 1 & " goes left"

                MsgBox sMsg, sStyle, sTitle

                With Me

                    tbxUser.Value = vbNullString

                    tbxPW = vbNullString

                    tbxUser.SetFocus

                    iCounta = iCounta - 1

                End With

            Else

                MsgBox "Correct Information Entered.  Please Proceed.", vbOKOnly, vbInformation, "Correct Information entered."

                bOK = True

                Sheet2.Activate

                Unload Me

            End If

    End Select

End Sub


Private Sub UserForm_Initialize()

    iCounta = 3

End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If bOK Then GoTo theend

    If CloseMode = 0 Then Cancel = True

    MsgBox "Sorry, you must enter your password & username", vbExclamation, "Warning"

theend:

End Sub
Quote ReplyReport
 
Upvote 0
thanks but gives me error in this line
VBA Code: 
MsgBox "Correct Information Entered.  Please Proceed.", vbOKOnly, vbInformation, "Correct Information entered."
invalid procedure call or argument
 
Last edited:
Upvote 0
You could do something like this to give the user 3 attempts

VBA Code: 
' in userform code module
Dim MaxAttempts As Long

Private Sub Userform_Initialize()
    MaxAttempts = 3
End Sub

Private Sub butSubmit_Click()
    If TextBox1.Value = "123AS89" And ComboBox1.Value = "ALI" Or TextBox1.Value = "567" And ComboBox1.Value = "OMAR" Then
        Me.Hide
        Application.Visible = True
        ThisWorkbook.Sheets("ENTER").Activate
   Else
        MaxAttempts = MaxAttempts - 1
        If 0 < MaxAttempts Then
            MsgBox "Try again"
        Else
            MsgBox "Too many attempts. Goodbye"
            Application.Quit
        End If
   End If
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

S
  • Solved
add a message box if a match using a userform list box doesn't match
Replies
7
Views
128
still learning
S
P
  • Question
auto refresh listbox2 in userform1
Replies
2
Views
336
Patriot2879
P
H
  • Question
How to login with username and password via Microsoft Edge in VBA code
Replies
1
Views
287
healeydm
H
L
  • Question
VBA to autosave and close after a set amount of time
Replies
3
Views
107
Anthony47
A
A
  • Question
expand code to search on userform more than column by selection from combobox
Replies
1
Views
493
abdelfattah
A

Forum statistics

Threads
1,214,920
Messages
6,122,269
Members
449,075
Latest member
staticfluids

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top