I made one userform which will help me to protect my code
when user open my file,my user form will pop up
evrething is working fine except this 3 things
1)i need few more changes in this program I have added Label 1 which is used to show "windows username"
it is not visible
2)i have 2 text box
I want to add this name just to visible in boxes i have tried code but its not working can yu please help out
Username in TxtUser,
Pasword in TxtPass.
3)if possible make smarter then my code
Please find the code below
Private Sub cmdCheck_Click()
'Declare the variables
Dim AddData As Range
Dim user As Variant
Dim Code As Variant
Dim result As Integer
Dim TitleStr As String
Dim Current As Range
Dim PName As Variant
Dim msg As VbMsgBoxResult
'Variables
user = Me.TxtUser.Value
Code = Me.TxtPass.Value
TitleStr = "Password check"
result = 0
Set Current = Sheet6.Range("K2")
'Error handler
On Error GoTo errHandler:
'Destination location for login storage
Set AddData = Sheet6.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
'Check the login and passcode for the administrator
If user = "Hardy Cross" And Code = 8118425 Then
MsgBox "Welcome Back: – " & user & vbCrLf _
& " You have admistrator priviledges" & vbCrLf _
& " I will open the control panel for you"
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'send the username to the worksheet
Current.Value = user
'unoad this form
Unload Me
'Show navigation form
UserForm1.Show
'End the procedure if conditions are meet
Exit Sub
End If
'Check the login and passcode for the administrator
If user = "San" And Code = "Traee" Then
MsgBox "Welcome: – " & user & " " & Code & vbCrLf
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'send the username to the worksheet
Current.Value = user
'unoad this form
Unload Me
'Show navigation form
UserForm1.Show
'End the procedure if conditions are meet
Exit Sub
End If
'Check the login and passcode for the administrator
If user = "Anthony Hunt" And Code = 1142081 Then
MsgBox "Welcome: – " & user & " " & Code & vbCrLf
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'send the username to the worksheet
Current.Value = user
'unoad this form
Unload Me
'Show navigation form
UserForm1.Show
'End the procedure if conditions are meet
Exit Sub
End If
'Check the login and passcode for the administrator
If user = "Ove Arup" And Code = 1182116 Then
MsgBox "Welcome: – " & user & " " & Code & vbCrLf
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'send the username to the worksheet
Current.Value = user
'unoad this form
Unload Me
'Show navigation form
UserForm1.Show
'End the procedure if conditions are meet
Exit Sub
End If
'Check user login with loop
If user <> "" And Code <> "" Then
For Each PName In Sheet6.Range("H2:H100")
'If PName = Code Then 'Use this for passcode text
If PName = CInt(Code) And PName.Offset(0, -1) = user Then ' Use this for passcode numbers only
MsgBox "Welcome Back: – " & user & " " & Code
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'Change variable if the condition is meet
result = 1
'Add usernmae to the worksheet
Current.Value = user
'Unload the form
Unload Me
'Show the navigation form
UserForm1.Show
Exit Sub
End If
Next PName
End If
' Next UName
'Check to see if an error occurred
If result = 0 Then
'Increment error variable
Trial = Trial + 1
'Less then 3 error message
If Trial < 3 Then msg = MsgBox("Wrong password, please try again", vbExclamation + vbOKOnly, TitleStr)
Me.TxtUser.SetFocus
'Last chance and close the workbook
If Trial = 3 Then
msg = MsgBox("Wrong password, the form will close…", vbCritical + vbOKOnly, TitleStr)
ActiveWorkbook.Close True
End If
End If
Exit Sub
'Error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
[/CODE]
when user open my file,my user form will pop up
evrething is working fine except this 3 things
1)i need few more changes in this program I have added Label 1 which is used to show "windows username"
it is not visible
2)i have 2 text box
I want to add this name just to visible in boxes i have tried code but its not working can yu please help out
Username in TxtUser,
Pasword in TxtPass.
3)if possible make smarter then my code
Please find the code below
Code:
Private Trial As Long
[CODE]
'Declare the variables
Dim AddData As Range
Dim user As Variant
Dim Code As Variant
Dim result As Integer
Dim TitleStr As String
Dim Current As Range
Dim PName As Variant
Dim msg As VbMsgBoxResult
'Variables
user = Me.TxtUser.Value
Code = Me.TxtPass.Value
TitleStr = "Password check"
result = 0
Set Current = Sheet6.Range("K2")
'Error handler
On Error GoTo errHandler:
'Destination location for login storage
Set AddData = Sheet6.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
'Check the login and passcode for the administrator
If user = "Hardy Cross" And Code = 8118425 Then
MsgBox "Welcome Back: – " & user & vbCrLf _
& " You have admistrator priviledges" & vbCrLf _
& " I will open the control panel for you"
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'send the username to the worksheet
Current.Value = user
'unoad this form
Unload Me
'Show navigation form
UserForm1.Show
'End the procedure if conditions are meet
Exit Sub
End If
'Check the login and passcode for the administrator
If user = "San" And Code = "Traee" Then
MsgBox "Welcome: – " & user & " " & Code & vbCrLf
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'send the username to the worksheet
Current.Value = user
'unoad this form
Unload Me
'Show navigation form
UserForm1.Show
'End the procedure if conditions are meet
Exit Sub
End If
'Check the login and passcode for the administrator
If user = "Anthony Hunt" And Code = 1142081 Then
MsgBox "Welcome: – " & user & " " & Code & vbCrLf
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'send the username to the worksheet
Current.Value = user
'unoad this form
Unload Me
'Show navigation form
UserForm1.Show
'End the procedure if conditions are meet
Exit Sub
End If
'Check the login and passcode for the administrator
If user = "Ove Arup" And Code = 1182116 Then
MsgBox "Welcome: – " & user & " " & Code & vbCrLf
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'send the username to the worksheet
Current.Value = user
'unoad this form
Unload Me
'Show navigation form
UserForm1.Show
'End the procedure if conditions are meet
Exit Sub
End If
'Check user login with loop
If user <> "" And Code <> "" Then
For Each PName In Sheet6.Range("H2:H100")
'If PName = Code Then 'Use this for passcode text
If PName = CInt(Code) And PName.Offset(0, -1) = user Then ' Use this for passcode numbers only
MsgBox "Welcome Back: – " & user & " " & Code
'record user login
AddData.Value = user
AddData.Offset(0, 1).Value = Now
'Change variable if the condition is meet
result = 1
'Add usernmae to the worksheet
Current.Value = user
'Unload the form
Unload Me
'Show the navigation form
UserForm1.Show
Exit Sub
End If
Next PName
End If
' Next UName
'Check to see if an error occurred
If result = 0 Then
'Increment error variable
Trial = Trial + 1
'Less then 3 error message
If Trial < 3 Then msg = MsgBox("Wrong password, please try again", vbExclamation + vbOKOnly, TitleStr)
Me.TxtUser.SetFocus
'Last chance and close the workbook
If Trial = 3 Then
msg = MsgBox("Wrong password, the form will close…", vbCritical + vbOKOnly, TitleStr)
ActiveWorkbook.Close True
End If
End If
Exit Sub
'Error block
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
[/CODE]
Code:
Private Sub frmLogin_Initialize()Label1.Caption = Environ("username")
Call settings
End Sub
Code:
Private Sub UserForm_QueryClose _
(Cancel As Integer, CloseMode As Integer)
' Prevents use of the Close button
If CloseMode = vbFormControlMenu Then
MsgBox "Clicking the Close button does not work."
Cancel = True
End If
End Sub
Code:
Sub settings()
With frmLogin
TxtUser.ForeColor = &H8000000C
TxtPass.ForeColor = &H8000000C
TxtUser.BackColor = &H80000004
TxtPass.BackColor = &H80000004
TxtUser.Text = "Username"
TxtPass.Text = "Password"
TxtUser.BorderColor = RGB(0, 191, 255)
TxtPass.BorderColor = RGB(0, 191, 255)
cmdCheck.SetFocus
TxtUser.TabIndex = 0
TxtPass.TabIndex = 1
cmdCheck.TabIndex = 2
End With
End Sub
Last edited: